Made some changes. Moved fields into Interstitial type. Results still…

… differ from baseline RRTMG.
climbfuji · Nov 4, 2019 · 78a8ed2 · 78a8ed2
1 parent fe6c9ae
commit 78a8ed2
Show file tree

Hide file tree

Showing 21 changed files with 186 additions and 267 deletions.
diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90
@@ -29,8 +29,8 @@ end subroutine GFS_rrtmgp_lw_post_init
 !!
   subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag,  Statein, im,   &
        p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,&
-       raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw,  hlwc, topflx_lw,           &
-       sfcflx_lw, flxprf_lw, hlw0, errmsg, errflg)
+       raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw,                             &
+       flxprf_lw, hlw0, errmsg, errflg)
 
     ! Inputs
     type(GFS_control_type), intent(in) :: &
@@ -68,24 +68,26 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag,  Statei
     real(kind_phys), dimension(im,Model%levs), intent(in) :: &
          cld_frac, & ! Total cloud fraction in each layer
          cldtaulw          ! approx 10.mu band layer cloud optical depth  
+    real(kind_phys),dimension(size(Grid%xlon,1), Model%levs)  :: &
+         hlwc             ! Longwave all-sky heating-rate          (K/sec)  
 
     ! Outputs (mandatory)
     character(len=*), intent(out) :: &
          errmsg
     integer, intent(out) :: &
          errflg
-    real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: &
-         hlwc             ! Longwave all-sky heating-rate          (K/sec)
-    type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
-         topflx_lw        ! radiation fluxes at top, components:
-                          ! upfxc - total sky upward flux at top   (w/m2)
-                          ! upfx0 - clear sky upward flux at top   (w/m2)
-    type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
-         sfcflx_lw        ! radiation fluxes at sfc, components:
-                          ! upfxc - total sky upward flux at sfc   (w/m2)  
-                          ! upfx0 - clear sky upward flux at sfc   (w/m2)
-                          ! dnfxc - total sky downward flux at sfc (w/m2)
-                          ! dnfx0 - clear sky downward flux at sfc (w/m2)
+!    real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: &
+!         hlwc             ! Longwave all-sky heating-rate          (K/sec)
+!    type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
+!         topflx_lw        ! radiation fluxes at top, components:
+!                          ! upfxc - total sky upward flux at top   (w/m2)
+!                          ! upfx0 - clear sky upward flux at top   (w/m2)
+!    type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: &
+!         sfcflx_lw        ! radiation fluxes at sfc, components:
+!                          ! upfxc - total sky upward flux at sfc   (w/m2)  
+!                          ! upfx0 - clear sky upward flux at sfc   (w/m2)
+!                          ! dnfxc - total sky downward flux at sfc (w/m2)
+!                          ! dnfx0 - clear sky downward flux at sfc (w/m2)
 
     ! Outputs (optional)
     real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: &
@@ -145,12 +147,12 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag,  Statei
 
        ! Copy fluxes from RRTGMP types into model radiation types.
        ! Mandatory outputs
-       topflx_lw%upfxc = fluxlwUP_allsky(:,iTOA)
-       topflx_lw%upfx0 = fluxlwUP_clrsky(:,iTOA)
-       sfcflx_lw%upfxc = fluxlwUP_allsky(:,iSFC)
-       sfcflx_lw%upfx0 = fluxlwUP_clrsky(:,iSFC)
-       sfcflx_lw%dnfxc = fluxlwDOWN_allsky(:,iSFC)
-       sfcflx_lw%dnfx0 = fluxlwDOWN_clrsky(:,iSFC)
+       Diag%topflw(:)%upfxc    = fluxlwUP_allsky(:,iTOA)
+       Diag%topflw(:)%upfx0    = fluxlwUP_clrsky(:,iTOA)
+       Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC)
+       Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC)
+       Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC)
+       Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC)
 
        ! Optional outputs
        if(l_fluxeslw2d) then
@@ -194,13 +196,13 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag,  Statei
        if (Model%lslwr) then
           do i=1,im
              ! LW all-sky fluxes
-             Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr *    Diag%topflw(i)%upfxc   ! total sky top lw up
-             Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * Radtend%sfcflw(i)%dnfxc   ! total sky sfc lw dn
-             Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * Radtend%sfcflw(i)%upfxc   ! total sky sfc lw up
+             Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky(  i,iTOA)   ! total sky top lw up
+             Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC)   ! total sky sfc lw dn
+             Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky(  i,iSFC)   ! total sky sfc lw up
              ! LW clear-sky fluxes
-             Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr *    Diag%topflw(i)%upfx0   ! clear sky top lw up
-             Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * Radtend%sfcflw(i)%dnfx0   ! clear sky sfc lw dn
-             Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * Radtend%sfcflw(i)%upfx0   ! clear sky sfc lw up
+             Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky(  i,iTOA)   ! clear sky top lw up
+             Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC)   ! clear sky sfc lw dn
+             Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky(  i,iSFC)   ! clear sky sfc lw up
           enddo
 
           do i=1,im

diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta
@@ -172,31 +172,6 @@
   kind = kind_phys
   intent = in
   optional = F
-[hlwc]
-  standard_name = RRTMGP_lw_heating_rate_all_sky
-  long_name = RRTMGP longwave all sky heating rate
-  units = K s-1
-  dimensions = (horizontal_dimension,vertical_dimension)
-  type = real
-  kind = kind_phys
-  intent = out
-  optional = F
-[topflx_lw]
-  standard_name = lw_fluxes_top_atmosphere
-  long_name = longwave total sky fluxes at the top of the atm
-  units = W m-2
-  dimensions = (horizontal_dimension)
-  type = topflw_type
-  intent = inout
-  optional = F
-[sfcflx_lw]
-  standard_name = lw_fluxes_sfc
-  long_name = longwave total sky fluxes at the Earth surface
-  units = W m-2
-  dimensions = (horizontal_dimension)
-  type = sfcflw_type
-  intent = inout
-  optional = F
 [flxprf_lw]
   standard_name = RRTMGP_lw_fluxes
   long_name = lw fluxes total sky / csk and up / down at levels

diff --git a/physics/GFS_rrtmgp_lw_pre.F90 b/physics/GFS_rrtmgp_lw_pre.F90
@@ -9,6 +9,7 @@ module GFS_rrtmgp_lw_pre
        GFS_sfcprop_type,         & ! Surface fields
        GFS_grid_type,            & ! Grid and interpolation related data
        GFS_statein_type,         & !
+       GFS_Interstitial_type,    & !
        GFS_radtend_type            ! Radiation tendencies needed in physics
   use module_radiation_surface,  only: &
        setemis                     ! Routine to compute surface-emissivity
@@ -31,7 +32,7 @@ end subroutine GFS_rrtmgp_lw_pre_init
 !! \htmlinclude GFS_rrtmgp_lw_pre.html
 !!
   subroutine GFS_rrtmgp_lw_pre_run (Model, Grid,  Sfcprop, Statein, ncol,  p_lay, p_lev, &
-       tv_lay, relhum, tracer, lw_gas_props, Radtend, aerosolslw, aerodp, errmsg, errflg)
+       tv_lay, relhum, tracer, lw_gas_props, Radtend, Interstitial, aerosolslw, aerodp, errmsg, errflg)
 
     ! Inputs
     type(GFS_control_type), intent(in) :: &
@@ -58,6 +59,8 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid,  Sfcprop, Statein, ncol,  p_lay,
     ! Outputs
     type(GFS_radtend_type), intent(inout) :: &
          Radtend              ! Fortran DDT containing FV3-GFS radiation tendencies 
+    type(GFS_interstitial_type), intent(inout) :: &
+         Interstitial
     real(kind_phys), dimension(ncol,Model%levs,lw_gas_props%get_nband(),NF_AELW), intent(out) ::&
          aerosolslw               ! Aerosol radiative properties in each SW band.
     real(kind_phys), dimension(ncol,NSPC1), intent(inout) :: &
@@ -97,15 +100,15 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid,  Sfcprop, Statein, ncol,  p_lay,
          Sfcprop%zorl, Sfcprop%tsfc,Sfcprop%tsfc, Sfcprop%hprime(:,1), NCOL,   &
          Radtend%semis)
     do iBand=1,lw_gas_props%get_nband()
-       Radtend%sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL)
+       Interstitial%sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL)
     enddo
 
     ! #######################################################################################
     ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile
     ! #######################################################################################
     call setaer(p_lev, p_lay, Statein%prslk(1:NCOL,iSFC:iTOA), tv_lay, relhum,              &
          Sfcprop%slmsk,  tracer, Grid%xlon, Grid%xlat, ncol, Model%levs, Model%levs+1,      &
-         .false., Model%lslwr, aerosolssw2, aerosolslw, aerodp)
+         .true., Model%lslwr, aerosolssw2, aerosolslw, aerodp)
 
 
   end subroutine GFS_rrtmgp_lw_pre_run

diff --git a/physics/GFS_rrtmgp_lw_pre.meta b/physics/GFS_rrtmgp_lw_pre.meta
@@ -9,6 +9,14 @@
   type = GFS_control_type
   intent = in
   optional = F
+[Interstitial]
+  standard_name = GFS_interstitial_type_instance
+  long_name = derived type GFS_interstitial_type in FV3
+  units = DDT
+  dimensions = ()
+  type = GFS_interstitial_type
+  intent = inout
+  optional = F
 [Grid]
   standard_name = GFS_grid_type_instance
   long_name = instance of derived type GFS_grid_type

diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90
@@ -232,15 +232,16 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
        do iLay=iSFC+1,iTOA
           t_lev(iCol,iLay) = (t_lay(iCol,iLay)+t_lay(iCol,iLay-1))/2._kind_phys
        enddo
-       t_lev(iCol,iTOA+1) = t_lev(iCol,iTOA) + (p_lev(iCol,iTOA+1)-p_lev(iCOL,iTOA))*&
-            (t_lev(iCol,iTOA)-t_lay(iCOL,iTOA))/(p_lev(iCol,iTOA)-p_lay(iCOL,iTOA))
+       t_lev(iCol,iTOA+1) = t_lay(iCol,iTOA)
+       !t_lev(iCol,iTOA+1) = t_lev(iCol,iTOA) + (p_lev(iCol,iTOA+1)-p_lev(iCOL,iTOA))*&
+       !     (t_lev(iCol,iTOA)-t_lay(iCOL,iTOA))/(p_lev(iCol,iTOA)-p_lay(iCOL,iTOA))
     enddo
 
     ! Guard against case when model uppermost model layer higher than rrtmgp allows.
     where(p_lev(1:nCol,iTOA+1) .lt. rrtmgp_minP)
        ! Set to RRTMGP min(pressure/temperature)
        p_lev(1:nCol,iTOA+1) = spread(rrtmgp_minP, dim=1,ncopies=ncol)
-       t_lev(1:nCol,iTOA+1) = spread(rrtmgp_minT, dim=1,ncopies=ncol)
+!       t_lev(1:nCol,iTOA+1) = spread(rrtmgp_minT, dim=1,ncopies=ncol)
        ! Recompute layer pressure/temperature.
        p_lay(1:NCOL,iTOA) = 0.5_kind_phys*(p_lev(1:NCOL,iTOA) +  p_lev(1:NCOL,iTOA+1))
        t_lay(1:NCOL,iTOA) = 0.5_kind_phys*(t_lev(1:NCOL,iTOA) +  t_lev(1:NCOL,iTOA+1))