<p><b>laura@ucar.edu</b> 2013-03-13 14:07:32 -0600 (Wed, 13 Mar 2013)</p><p>Updated RRTMG shortwave radiation code to WRF versions 3.4.1. Results are exactly the same as those obtained with RRTMG shortwave radiation code from WRF version 3.2.1<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F
===================================================================
--- branches/atmos_physics/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F        2013-03-13 18:05:30 UTC (rev 2603)
+++ branches/atmos_physics/src/core_atmos_physics/physics_wrf/module_ra_rrtmg_sw.F        2013-03-13 20:07:32 UTC (rev 2604)
@@ -8544,8 +8544,14 @@
              taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl , &amp;
              ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &amp;
              tauaer  ,ssaaer  ,asmaer  ,ecaer   , &amp;
-             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc)
+             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc,  &amp;
+! --------- Add the following four compenants for ssib shortwave down radiation ---!
+! -------------------      by Zhenxin 2011-06-20      --------------------------------!
+             sibvisdir, sibvisdif, sibnirdir, sibnirdif          &amp;
+                                                                )
+! ----------------------  End,  Zhenxin 2011-06-20    --------------------------------!
 
+
 ! ------- Description -------
 
 ! This program is the driver for RRTMG_SW, the AER SW radiation model for 
@@ -8743,6 +8749,14 @@
                                                       !    Dimensions: (ncol,nlay+1)
       real(kind=rb), intent(out) :: swdflx(:,:)       ! Total sky shortwave downward flux (W/m2)
                                                       !    Dimensions: (ncol,nlay+1)
+      real(kind=rb), intent(out) :: sibvisdir(:,:)    ! visible direct downward flux  (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
+      real(kind=rb), intent(out) :: sibvisdif(:,:)    ! visible diffusion downward flux  (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
+      real(kind=rb), intent(out) :: sibnirdir(:,:)    ! Near IR direct downward flux  (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1)  Zhenxin (2011/06/20)
+      real(kind=rb), intent(out) :: sibnirdif(:,:)    ! Near IR diffusion downward flux  (W/m2)
+                                                      !    Dimensions: (ncol,nlay+1) Zhenxin (2011/06/20)
       real(kind=rb), intent(out) :: swhr(:,:)         ! Total sky shortwave radiative heating rate (K/d)
                                                       !    Dimensions: (ncol,nlay)
       real(kind=rb), intent(out) :: swuflxc(:,:)      ! Clear sky shortwave upward flux (W/m2)
@@ -9070,7 +9084,7 @@
                do ib = 1, nbndsw
                   ztaua(i,ib) = 0._rb
                   zasya(i,ib) = 0._rb
-                  zomga(i,ib) = 1._rb
+                  zomga(i,ib) = 0._rb
                   do ia = 1, naerec
                      ztaua(i,ib) = ztaua(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia)
                      zomga(i,ib) = zomga(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &amp;
@@ -9142,15 +9156,24 @@
             swdflx(iplon,i) = zbbfd(i)
             uvdflx(i) = zuvfd(i)
             nidflx(i) = znifd(i)
+
 !  Direct/diffuse fluxes
             dirdflux(i) = zbbfddir(i)
             difdflux(i) = swdflx(iplon,i) - dirdflux(i)
 !  UV/visible direct/diffuse fluxes
             dirdnuv(i) = zuvfddir(i)
             difdnuv(i) = zuvfd(i) - dirdnuv(i)
+!  ------- Zhenxin add vis/uv downwards dir or dif here --!
+            sibvisdir(iplon,i) = dirdnuv(i)
+            sibvisdif(iplon,i) = difdnuv(i)
+!  ----- End of Zhenxin addition  ------------!
 !  Near-IR direct/diffuse fluxes
             dirdnir(i) = znifddir(i)
             difdnir(i) = znifd(i) - dirdnir(i)
+!  ---------Zhenxin add nir downwards dir and dif here --!
+            sibnirdir(iplon,i) = dirdnir(i)
+            sibnirdif(iplon,i) = difdnir(i)
+!  --------    End of Zhenxin addition 2011-05  ---------!
          enddo
 
 !  Total and clear sky net fluxes
@@ -9546,12 +9569,12 @@
 MODULE module_ra_rrtmg_sw
 
 #if defined(non_hydrostatic_core) || defined(hydrostatic_core)
-!MPAS specific (Laura D. Fowler):
+!MPAS specific (Laura D. Fowler - 2013-03-11):
 use mpas_atmphys_constants,only: cp
 #else
 use module_model_constants, only : cp
-use module_wrf_error
-!use module_dm
+USE module_wrf_error
+!USE module_dm
 #endif
 !MPAS specific end.
 
@@ -9584,7 +9607,19 @@
                        xland, xice, snow,                         &amp;
                        qv3d, qc3d, qr3d,                          &amp;
                        qi3d, qs3d, qg3d,                          &amp;
+                       alswvisdir, alswvisdif,                    &amp;  !Zhenxin ssib alb comp (06/20/2011)
+                       alswnirdir, alswnirdif,                    &amp;  !Zhenxin ssib alb comp (06/20/2011)
+                       swvisdir, swvisdif,                        &amp;  !Zhenxin ssib swr comp (06/20/2011)
+                       swnirdir, swnirdif,                        &amp;  !Zhenxin ssib swi comp (06/20/2011)
+                       sf_surface_physics,                        &amp;  !Zhenxin
                        f_qv, f_qc, f_qr, f_qi, f_qs, f_qg,        &amp;
+                       tauaer300,tauaer400,tauaer600,tauaer999,   &amp; ! czhao 
+                       gaer300,gaer400,gaer600,gaer999,           &amp; ! czhao 
+                       waer300,waer400,waer600,waer999,           &amp; ! czhao 
+                       aer_ra_feedback,                           &amp;
+!jdfcz                 progn,prescribe,                           &amp;
+                       progn,                                     &amp;
+                       qndrop3d,f_qndrop,                         &amp; !czhao
                        ids,ide, jds,jde, kds,kde,                 &amp; 
                        ims,ime, jms,jme, kms,kme,                 &amp;
                        its,ite, jts,jte, kts,kte,                 &amp;
@@ -9631,6 +9666,24 @@
                                                              TSK, &amp;
                                                           ALBEDO
 !
+!!! -------------------  Zhenxin (2011-06/20) ------------------
+   REAL, DIMENSION( ims:ime, jms:jme )                         , &amp;
+         OPTIONAL                                               , &amp;
+         INTENT(IN)     ::                            ALSWVISDIR, &amp;     ! ssib albedo of sw and lw
+                                                      ALSWVISDIF, &amp;
+                                                      ALSWNIRDIR, &amp;
+                                                      ALSWNIRDIF
+
+   REAL, DIMENSION( ims:ime, jms:jme )                         , &amp;
+         OPTIONAL                                               , &amp;
+         INTENT(OUT)    ::                              SWVISDIR, &amp;
+                                                        SWVISDIF, &amp;
+                                                        SWNIRDIR, &amp;
+                                                        SWNIRDIF        ! ssib sw dir and diff rad
+   INTEGER, INTENT(IN) :: sf_surface_physics                            ! ssib para
+
+!  ----------------------- end Zhenxin --------------------------
+!
    REAL, INTENT(IN  )   ::                                   R,G
 !
 ! Optional
@@ -9644,8 +9697,11 @@
                                                             QR3D, &amp;
                                                             QI3D, &amp;
                                                             QS3D, &amp;
-                                                            QG3D
+                                                            QG3D, &amp;
+                                                        QNDROP3D
 
+   real pi,third,relconst,lwpmin,rhoh2o
+
    REAL, DIMENSION( ims:ime, kms:kme, jms:jme )                 , &amp;
          OPTIONAL                                               , &amp;
          INTENT(IN   ) ::                                         &amp;
@@ -9653,8 +9709,30 @@
                                                       F_RAIN_PHY
 
    LOGICAL, OPTIONAL, INTENT(IN)   ::                             &amp;
-                                   F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
+                                F_QV,F_QC,F_QR,F_QI,F_QS,F_QG,F_QNDROP
 
+! Optional
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL ,       &amp;
+         INTENT(IN    ) :: tauaer300,tauaer400,tauaer600,tauaer999, &amp; ! czhao 
+                                 gaer300,gaer400,gaer600,gaer999, &amp; ! czhao 
+                                 waer300,waer400,waer600,waer999    ! czhao 
+
+   INTEGER,    INTENT(IN  ), OPTIONAL   ::       aer_ra_feedback
+!jdfcz   INTEGER,    INTENT(IN  ), OPTIONAL   ::       progn,prescribe
+   INTEGER,    INTENT(IN  ), OPTIONAL   ::       progn
+
+      !wavelength corresponding to wavenum1 and wavenum2 (cm-1)
+      real, save :: wavemin(nbndsw) ! Min wavelength (um) of 14 intervals
+      data wavemin /3.077,2.500,2.150,1.942,1.626,1.299, &amp;
+      1.242,0.778,0.625,0.442,0.345,0.263,0.200,3.846/
+      real, save :: wavemax(nbndsw) ! Max wavelength (um) of interval
+      data wavemax/3.846,3.077,2.500,2.150,1.942,1.626, &amp;
+      1.299,1.242,0.778,0.625,0.442,0.345,0.263,12.195/
+      real wavemid(nbndsw) ! Mid wavelength (um) of interval
+      real, parameter :: thresh=1.e-9
+      real ang,slope
+      character(len=200) :: msg
+
 ! Top of atmosphere and surface shortwave fluxes (W m-2)
    REAL, DIMENSION( ims:ime, jms:jme ),                           &amp;
          OPTIONAL, INTENT(INOUT) ::                               &amp;
@@ -9663,8 +9741,7 @@
 
 ! Layer shortwave fluxes (including extra layer above model top)
 ! Vertical ordering is from bottom to top (W m-2)
-!  REAL, DIMENSION( ims:ime, kms:kme+2, jms:jme ),                &amp;
-   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ),                &amp;
+   REAL, DIMENSION( ims:ime, kms:kme+2, jms:jme ),                &amp;
          OPTIONAL, INTENT(OUT) ::                                 &amp;
                                SWUPFLX,SWUPFLXC,SWDNFLX,SWDNFLXC
 
@@ -9683,7 +9760,8 @@
                                                             QR1D, &amp;
                                                             QI1D, &amp;
                                                             QS1D, &amp;
-                                                            QG1D
+                                                            QG1D, &amp;
+                                                          qndrop1d 
 
 ! Added local arrays for RRTMG
     integer ::                                              ncol, &amp;
@@ -9739,7 +9817,11 @@
     real, dimension( 1, kts:kte+2 )  ::                   swuflx, &amp;
                                                           swdflx, &amp;
                                                          swuflxc, &amp;
-                                                         swdflxc
+                                                         swdflxc, &amp;
+                                                       sibvisdir, &amp;  ! Zhenxin 2011-06-20
+                                                       sibvisdif, &amp;
+                                                       sibnirdir, &amp;
+                                                       sibnirdif     ! Zhenxin 2011-06-20
     real, dimension( 1, kts:kte+1 )  ::                     swhr, &amp;
                                                            swhrc
 
@@ -9822,6 +9904,26 @@
     LOGICAL :: predicate
 
 !------------------------------------------------------------------
+#ifdef WRF_CHEM
+      IF ( aer_ra_feedback == 1) then
+      IF ( .NOT. &amp;
+      ( PRESENT(tauaer300) .AND. &amp;
+        PRESENT(tauaer400) .AND. &amp;
+        PRESENT(tauaer600) .AND. &amp;
+        PRESENT(tauaer999) .AND. &amp;
+        PRESENT(gaer300) .AND. &amp;
+        PRESENT(gaer400) .AND. &amp;
+        PRESENT(gaer600) .AND. &amp;
+        PRESENT(gaer999) .AND. &amp;
+        PRESENT(waer300) .AND. &amp;
+        PRESENT(waer400) .AND. &amp;
+        PRESENT(waer600) .AND. &amp;
+        PRESENT(waer999) ) ) THEN
+      CALL wrf_error_fatal  &amp;
+      ('Warning: missing fields required for aerosol radiation' )
+      ENDIF
+      ENDIF
+#endif
 
 !-----CALCULATE SHORT WAVE RADIATION
 !                                                              
@@ -9850,6 +9952,7 @@
 !         clat(i) = xxlat
          coszrs = sin(xxlat) * sin(declin) + cos(xxlat) * cos(declin) * cos(hrang)
          coszr(i,j) = coszrs
+
 ! Set flag to prevent shortwave calculation when sun below horizon
          if (coszrs.le.0.0) dorrsw = .false.
 ! Perform shortwave calculation if sun above horizon
@@ -9867,6 +9970,7 @@
             QI1D(K)=0.
             QS1D(K)=0.
             CLDFRA1D(k)=0.
+            QNDROP1D(k)=0.
          ENDDO
 
          DO K=kts,kte
@@ -9908,6 +10012,14 @@
               ENDIF
             ENDIF
 
+            IF ( PRESENT(F_QNDROP).AND.PRESENT(QNDROP3D)) THEN
+             IF (F_QNDROP) THEN
+              DO K=kts,kte
+               qndrop1d(K)=qndrop3d(I,K,J)
+              ENDDO
+             ENDIF
+            ENDIF
+
 ! This logic is tortured because cannot test F_QI unless
 ! it is present, and order of evaluation of expressions
 ! is not specified in Fortran
@@ -10053,11 +10165,31 @@
 
 ! Set surface albedo for direct and diffuse radiation in UV/visible and
 ! near-IR spectral regions
+! -------------- Zhenxin 2011-06-20 ----------- !
+
+! ------- 1.  Commented by Zhenxin 2011-06-20 for SSiB coupling modified ---- !
+!         asdir(ncol) = albedo(i,j)
+!         asdif(ncol) = albedo(i,j)
+!         aldir(ncol) = albedo(i,j)
+!         aldif(ncol) = albedo(i,j)
+! -------    End of Comments    ------ !
+
+! ------- 2. New Addiation  ------ !
+    IF ( sf_surface_physics .eq. 8 .AND. XLAND(i,j) .LT. 1.5) THEN
+         asdir(ncol) = ALSWVISDIR(I,J)
+         asdif(ncol) = ALSWVISDIF(I,J)
+         aldir(ncol) = ALSWNIRDIR(I,J)
+         aldif(ncol) = ALSWNIRDIF(I,J)
+    ELSE
          asdir(ncol) = albedo(i,j)
          asdif(ncol) = albedo(i,j)
          aldir(ncol) = albedo(i,j)
          aldif(ncol) = albedo(i,j)
+    ENDIF
 
+! ---------- End of Addiation ------!
+! ----------  End of fds_Zhenxin 2011-06-20   --------------!
+
 ! Define cloud optical properties for radiation (inflgsw = 0)
 ! This option is not currently active
 ! Cloud and precipitation paths in g/m2 
@@ -10114,12 +10246,59 @@
                cliqwp(ncol,k) = gliqwp / max(0.01,cldfrac(ncol,k))               ! In-cloud liquid water path.
             end do
 
+!link the aerosol feedback to cloud  -czhao
+  if( PRESENT( progn ) ) then
+    if (progn == 1) then
+!jdfcz     if(prescribe==0) then
+
+      pi = 4.*atan(1.0)
+      third=1./3.
+      rhoh2o=1.e3
+      relconst=3/(4.*pi*rhoh2o)
+!     minimun liquid water path to calculate rel
+!     corresponds to optical depth of 1.e-3 for radius 4 microns.
+      lwpmin=3.e-5
+      do k = kts, kte
+         reliq(ncol,k) = 10.
+         if( PRESENT( F_QNDROP ) ) then
+            if( F_QNDROP ) then
+              if ( qc1d(k)*pdel(ncol,k).gt.lwpmin.and. &amp;
+                   qndrop1d(k).gt.1000. ) then
+               reliq(ncol,k)=(relconst*qc1d(k)/qndrop1d(k))**third ! effective radius in m
+!           apply scaling from Martin et al., JAS 51, 1830.
+               reliq(ncol,k)=1.1*reliq(ncol,k)
+               reliq(ncol,k)=reliq(ncol,k)*1.e6 ! convert from m to microns
+               reliq(ncol,k)=max(reliq(ncol,k),4.)
+               reliq(ncol,k)=min(reliq(ncol,k),20.)
+              end if
+            end if
+         end if
+      end do
+!jdfcz     else ! prescribe 
 ! following Kiehl
-            call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+      call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+!      write(0,*) 'sw prescribe aerosol',maxval(qndrop3d)
+!jdfcz     endif
+    else  ! progn   
+      call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+    endif
+  else   !progn 
+      call relcalc(ncol, pcols, pver, tlay, landfrac, landm, icefrac, reliq, snowh)
+  endif
 
 ! following Kristjansson and Mitchell
-            call reicalc(ncol, pcols, pver, tlay, reice)
+      call reicalc(ncol, pcols, pver, tlay, reice)
 
+#if 0
+      if (i==80.and.j==30) then
+#if defined( DM_PARALLEL ) &amp;&amp; ! defined( STUBMPI) 
+      if( PRESENT( progn ) ) write(0,*) 'aerosol indirect',progn
+      write(0,*)'sw water eff radius',reliq(ncol,10),reliq(ncol,20),reliq(ncol,25)
+      write(0,*)'sw ice eff radius',reice(ncol,10),reice(ncol,20),reice(ncol,25)
+#endif
+      endif
+#endif
+
 ! Limit upper bound of reice for Fu ice parameterization and convert
 ! from effective radius to generalized effective size (*1.0315; Fu, 1996)
             if (iceflgsw .eq. 3) then
@@ -10172,17 +10351,111 @@
                        cldfmcl, ciwpmcl, clwpmcl, reicmcl, relqmcl, &amp;
                        taucmcl, ssacmcl, asmcmcl, fsfcmcl)
 
-! Aerosol optical depth, single scattering albedo and asymmetry parameter
+!--------------------------------------------------------------------------
+! Aerosol optical depth, single scattering albedo and asymmetry parameter -czhao 03/2010
+!--------------------------------------------------------------------------
 ! by layer for each RRTMG shortwave band
 ! No aerosols in top layer above model top (kte+1).
-         do nb = 1, nbndsw
-            do k = kts, kte+1
-               tauaer(ncol,k,nb) = 0.
-               ssaaer(ncol,k,nb) = 1.
-               asmaer(ncol,k,nb) = 0.
-            enddo
-         enddo
+!cz        do nb = 1, nbndsw
+!cz           do k = kts, kte+1
+!cz              tauaer(ncol,k,nb) = 0.
+!cz              ssaaer(ncol,k,nb) = 1.
+!cz              asmaer(ncol,k,nb) = 0.
+!cz           enddo
+!cz        enddo
 
+! ... Aerosol effects. Added aerosol feedbacks from Chem , 03/2010 -czhao
+!
+      do nb = 1, nbndsw
+      do k = kts,kte+1
+         tauaer(ncol,k,nb) = 0.
+         ssaaer(ncol,k,nb) = 1.
+         asmaer(ncol,k,nb) = 0.
+      end do
+      end do
+
+#ifdef WRF_CHEM
+   IF ( AER_RA_FEEDBACK == 1) then
+      do nb = 1, nbndsw
+         wavemid(nb)=0.5*(wavemin(nb)+wavemax(nb))  ! um
+      do k = kts,kte      !wig
+
+! convert optical properties at 300,400,600, and 999 to conform to the band wavelengths
+! tauaer - use angstrom exponent
+        if(tauaer300(i,k,j).gt.thresh .and. tauaer999(i,k,j).gt.thresh) then
+           ang=alog(tauaer300(i,k,j)/tauaer999(i,k,j))/alog(999./300.)
+           tauaer(ncol,k,nb)=tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+           !tauaer(ncol,k,nb)=tauaer600(i,k,j)*(0.6/wavemid(nb))**ang 
+           if (i==30.and.j==49.and.k==2.and.nb==12) then
+            write(0,*) 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
+            print*, 'TAU from 600 vs 400 in RRTMG',tauaer600(i,k,j),tauaer400(i,k,j)
+            write(0,*) tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+            print*, tauaer600(i,k,j)*(0.6/wavemid(nb))**ang,tauaer400(i,k,j)*(0.4/wavemid(nb))**ang
+           endif
+! ssa - linear interpolation; extrapolation
+           slope=(waer600(i,k,j)-waer400(i,k,j))/.2
+           ssaaer(ncol,k,nb) = slope*(wavemid(nb)-.6)+waer600(i,k,j)
+           if(ssaaer(ncol,k,nb).lt.0.4) ssaaer(ncol,k,nb)=0.4
+           if(ssaaer(ncol,k,nb).ge.1.0) ssaaer(ncol,k,nb)=1.0
+! g - linear interpolation;extrapolation
+           slope=(gaer600(i,k,j)-gaer400(i,k,j))/.2
+           asmaer(ncol,k,nb) = slope*(wavemid(nb)-.6)+gaer600(i,k,j) ! notice reversed varaibles
+           if(asmaer(ncol,k,nb).lt.0.5) asmaer(ncol,k,nb)=0.5
+           if(asmaer(ncol,k,nb).ge.1.0) asmaer(ncol,k,nb)=1.0
+        endif
+      end do ! k
+      end do ! nb
+
+!wig beg
+      do nb = 1, nbndsw
+         slope = 0.  !use slope as a sum holder
+         do k = kts,kte
+            slope = slope + tauaer(ncol,k,nb)
+         end do
+         if( slope &lt; 0. ) then
+            write(msg,'(&quot;ERROR: Negative total optical depth of &quot;,f8.2,&quot; at point i,j,nb=&quot;,3i5)') slope,i,j,nb
+            call wrf_error_fatal(msg)
+         else if( slope &gt; 6. ) then
+            call wrf_message(&quot;-------------------------&quot;)
+            write(msg,'(&quot;WARNING: Large total sw optical depth of &quot;,f8.2,&quot; at point i,j,nb=&quot;,3i5)') slope,i,j,nb
+            call wrf_message(msg)
+
+            call wrf_message(&quot;Diagnostics 1: k, tauaer300, tauaer400, tauaer600, tauaer999, tauaer&quot;)
+            do k=kts,kte
+               write(msg,'(i4,5f8.2)') k, tauaer300(i,k,j), tauaer400(i,k,j), &amp;
+                    tauaer600(i,k,j), tauaer999(i,k,j),tauaer(ncol,k,nb)
+               call wrf_message(msg)
+               !czhao set an up-limit here to avoid segmentation fault 
+               !from extreme AOD
+               tauaer(ncol,k,nb)=tauaer(ncol,k,nb)*6.0/slope 
+            end do
+
+            call wrf_message(&quot;Diagnostics 2: k, gaer300, gaer400, gaer600, gaer999&quot;)
+            do k=kts,kte
+               write(msg,'(i4,4f8.2)') k, gaer300(i,k,j), gaer400(i,k,j), &amp;
+                    gaer600(i,k,j), gaer999(i,k,j)
+               call wrf_message(msg)
+            end do
+
+            call wrf_message(&quot;Diagnostics 3: k, waer300, waer400, waer600, waer999&quot;)
+            do k=kts,kte
+               write(msg,'(i4,4f8.2)') k, waer300(i,k,j), waer400(i,k,j), &amp;
+                    waer600(i,k,j), waer999(i,k,j)
+               call wrf_message(msg)
+            end do
+
+            call wrf_message(&quot;Diagnostics 4: k, ssaal, asyal, taual&quot;)
+            do k=kts-1,kte
+               write(msg,'(i4,3f8.2)') k, ssaaer(i,k,nb), asmaer(i,k,nb), tauaer(i,k,nb)
+               call wrf_message(msg)
+            end do
+            call wrf_message(&quot;-------------------------&quot;)
+         endif
+      enddo  ! nb
+      endif  ! aer_ra_feedback
+#endif
+
+
 ! Zero array for input of aerosol optical thickness for use with
 ! ECMWF aerosol types (not used)
          do na = 1, naerec
@@ -10203,7 +10476,11 @@
              taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl , &amp;
              ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &amp;
              tauaer  ,ssaaer  ,asmaer  ,ecaer   , &amp;
-             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc)
+             swuflx  ,swdflx  ,swhr    ,swuflxc ,swdflxc ,swhrc, &amp;
+! -----          Zhenxin added for ssib coupiling 2011-06-20 --------!
+             sibvisdir, sibvisdif, sibnirdir, sibnirdif          &amp;
+                                                        )
+! --------------------   End of addiation by Zhenxin 2011-06-20 ------!
 
 ! Output net absorbed shortwave surface flux and shortwave cloud forcing
 ! at the top of atmosphere (W/m2)
@@ -10220,6 +10497,12 @@
             swupb(i,j)     = swuflx(1,1)
             swupbc(i,j)    = swuflxc(1,1)
             swdnb(i,j)     = swdflx(1,1)
+! Added by Zhenxin for 4 compenants of swdown radiation
+            swvisdir(i,j)  = sibvisdir(1,1)
+            swvisdif(i,j)  = sibvisdif(1,1)
+            swnirdir(i,j)  = sibnirdir(1,1)
+            swnirdif(i,j)  = sibnirdif(1,1)
+!  Ended, Zhenxin (2011/06/20)
             swdnbc(i,j)    = swdflxc(1,1)
          endif
 
@@ -10252,6 +10535,10 @@
             swupbc(i,j)    = 0.
             swdnb(i,j)     = 0.
             swdnbc(i,j)    = 0.
+            swvisdir(i,j)  = 0.  ! Add by Zhenxin (2011/06/20)
+            swvisdif(i,j)  = 0.
+            swnirdir(i,j)  = 0.
+            swnirdif(i,j)  = 0.  ! Add by Zhenxin (2011/06/20)
          endif
 
       endif
@@ -10264,15 +10551,14 @@
 
    END SUBROUTINE RRTMG_SWRAD
 

-!ldf (12-20-2010): This section of the module is moved to module_physics_rrtmg_swinit.F in
+!ldf (2013-03-11): This section of the module is moved to module_physics_rrtmg_swinit.F in
 !./../core_physics to accomodate differences in the mpi calls between WRF and MPAS.I thought
 !that it would be cleaner to do this instead of adding a lot of #ifdef statements throughout
 !the initialization of the shortwave radiation code. Initialization is handled the same way
 !for the longwave radiation code.
 
 #if !(defined(non_hydrostatic_core) || defined(hydrostatic_core))
-

 !====================================================================
    SUBROUTINE rrtmg_swinit(                                         &amp;
                        allowed_to_read ,                            &amp;
@@ -10325,11 +10611,7 @@
         rrtmg_unit = -1
  2010   CONTINUE
       ENDIF
-!ldf (11-08-2010): changed wrf_dm_bcast_bytes to wrf_dm_bcast_integer to avoid warning at
-!compilation time:
-!     CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE )
-      CALL wrf_dm_bcast_integer ( rrtmg_unit , IWORDSIZE )
-!ldf end.
+      CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE )
       IF ( rrtmg_unit &lt; 0 ) THEN
         CALL wrf_error_fatal ( 'module_ra_rrtmg_sw: rrtm_swlookuptable: Can not '// &amp;
                                'find unused fortran unit to read in lookup table.' )
@@ -11454,6 +11736,6 @@
 !------------------------------------------------------------------
 
 #endif
-!ldf end (12-20-2010).
+!ldf end (2013-03-11).
 
 END MODULE module_ra_rrtmg_sw

</font>
</pre>