Added solar constant adjustment factor to incident SW TOA flux. GP SW…

… downward fluxes now agree with baseline G downward fluxes.
climbfuji · Nov 7, 2019 · 54e0066 · 54e0066
1 parent 69bf621
commit 54e0066
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 48 deletions.
diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90
@@ -50,7 +50,7 @@ module GFS_rrtmgp_pre
   ! RRTMGP types
   use mo_gas_optics_rrtmgp,  only: ty_gas_optics_rrtmgp
   use mo_gas_concentrations, only: ty_gas_concs
-  use rrtmgp_aux,            only: check_error_msg, rrtmgp_minP, rrtmgp_minT
+  use rrtmgp_aux,            only: check_error_msg!, rrtmgp_minP, rrtmgp_minT
 
   real(kind_phys), parameter :: &
        amd   = 28.9644_kind_phys,  & ! Molecular weight of dry-air     (g/mol)
@@ -117,7 +117,7 @@ end subroutine GFS_rrtmgp_pre_init
 !! \htmlinclude GFS_rrtmgp_pre.html
 !!
   subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN
-       ncol, lw_gas_props, sw_gas_props,                                                & ! IN
+       ncol,                                                                            & ! IN
        raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,                & ! OUT
        cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain,         & ! OUT
        tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth,  gas_concentrations,       & ! OUT
@@ -140,9 +140,6 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
          Tbd                  ! Fortran DDT containing FV3-GFS data not yet assigned to a defined container
     integer, intent(in)    :: &
          ncol                 ! Number of horizontal grid points
-    type(ty_gas_optics_rrtmgp),intent(in) :: &
-         lw_gas_props,      & ! RRTMGP DDT containing spectral information for LW calculation
-         sw_gas_props         ! RRTMGP DDT containing spectral information for SW calculation
 
     ! Outputs
     real(kind_phys), dimension(ncol,Model%levs), intent(out) :: &
@@ -233,20 +230,8 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
           t_lev(iCol,iLay) = (t_lay(iCol,iLay)+t_lay(iCol,iLay-1))/2._kind_phys
        enddo
        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)
-       ! 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))
-    end where
-
     ! Compute layer pressure thicknes
     deltaP = p_lev(:,iSFC:iTOA)-p_lev(:,iSFC+1:iTOA+1)
 

diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta
@@ -103,22 +103,6 @@
   type = integer
   intent = in
   optional = F
-[lw_gas_props]
-  standard_name = coefficients_for_lw_gas_optics
-  long_name = DDT containing spectral information for RRTMGP LW radiation scheme
-  units = DDT
-  dimensions = ()
-  type = ty_gas_optics_rrtmgp
-  intent = in
-  optional = F
-[sw_gas_props]
-  standard_name = coefficients_for_sw_gas_optics
-  long_name = DDT containing spectral information for RRTMGP SW radiation scheme
-  units = DDT
-  dimensions = ()
-  type = ty_gas_optics_rrtmgp
-  intent = in
-  optional = F
 [raddt]
   standard_name = time_step_for_radiation
   long_name = radiation time step

diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90
@@ -7,7 +7,7 @@ module rrtmgp_lw_gas_optics
   use mo_source_functions,   only: ty_source_func_lw
   use mo_optical_props,      only: ty_optical_props_1scl
   use mo_compute_bc,         only: compute_bc
-  use rrtmgp_aux,            only: check_error_msg, rrtmgp_minP, rrtmgp_minT
+  use rrtmgp_aux,            only: check_error_msg
   use netcdf
 
   ! Parameters
@@ -391,10 +391,6 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
     ! Set initial permutation seed for McICA, initially set to number of G-points
     ipsdlw0 = lw_gas_props%get_ngpt()
 
-    ! Store minimum pressure/temperature allowed by RRTMGP
-    rrtmgp_minP = lw_gas_props%get_press_min()
-    rrtmgp_minT = lw_gas_props%get_temp_min()
-
   end subroutine rrtmgp_lw_gas_optics_init
 
   ! #########################################################################################

diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90
@@ -5,7 +5,7 @@ module rrtmgp_sw_gas_optics
   use mo_rte_kind,            only: wl
   use mo_gas_optics_rrtmgp,   only: ty_gas_optics_rrtmgp
   use mo_gas_concentrations,  only: ty_gas_concs
-  use rrtmgp_aux,             only: check_error_msg, rrtmgp_minP, rrtmgp_minT
+  use rrtmgp_aux,             only: check_error_msg
   use mo_optical_props,       only: ty_optical_props_2str
   use mo_compute_bc,          only: compute_bc
   use netcdf
@@ -106,7 +106,7 @@ subroutine rrtmgp_sw_gas_optics_init(Model,  mpicomm, mpirank, mpiroot, sw_gas_p
 
     ! Local variables
     integer :: status,ncid_sw,dimid,varID,iGas
-    integer,dimension(:),allocatable :: temp1,temp2,temp3,temp4, temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4
+    integer,dimension(:),allocatable :: temp1,temp2,temp3,temp4
     character(len=264) :: sw_gas_props_file
 
     ! Initialize
@@ -390,10 +390,6 @@ subroutine rrtmgp_sw_gas_optics_init(Model,  mpicomm, mpirank, mpiroot, sw_gas_p
     ! Set initial permutation seed for McICA, initially set to number of G-points
     ipsdsw0 = sw_gas_props%get_ngpt()
 
-    ! Store minimum pressure/temperature allowed by RRTMGP
-    rrtmgp_minP = sw_gas_props%get_press_min()
-    rrtmgp_minT = sw_gas_props%get_temp_min()
-
   end subroutine rrtmgp_sw_gas_optics_init
 
   ! #########################################################################################
@@ -408,14 +404,13 @@ end subroutine rrtmgp_sw_gas_optics_init
 !! \htmlinclude rrtmgp_sw_gas_optics.html
 !!
   subroutine rrtmgp_sw_gas_optics_run(Model, Interstitial, sw_gas_props, ncol, p_lay, p_lev, t_lay, t_lev, &
-       gas_concentrations, lsswr, sw_optical_props_clrsky, errmsg, errflg)
+       gas_concentrations, lsswr, solcon, sw_optical_props_clrsky, errmsg, errflg)
 
     ! Inputs
     type(GFS_control_type), intent(in) :: &
          Model                   ! DDT containing model control parameters
     type(GFS_Interstitial_type),intent(inout) :: &
          Interstitial
-
     type(ty_gas_optics_rrtmgp),intent(in) :: &
          sw_gas_props            ! DDT containing spectral information for RRTMGP SW radiation scheme
     integer,intent(in) :: &
@@ -430,7 +425,8 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Interstitial, sw_gas_props, ncol, p_l
          gas_concentrations      ! RRTMGP DDT: trace gas concentrations   (vmr)
     logical, intent(in) :: &
          lsswr                   ! Flag to calculate SW irradiances
-
+    real(kind_phys), intent(in) :: &
+         solcon                  ! Solar constant
     ! Output
     character(len=*), intent(out) :: &
          errmsg                  ! Error message
@@ -450,14 +446,17 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Interstitial, sw_gas_props, ncol, p_l
 
     ! Gas-optics (djs asks pincus: I think it makes sense to have a generic gas_optics interface in 
     ! ty_gas_optics_rrtmgp, just as in ty_gas_optics.
-    call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics_ext(&
+    call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics(&
          p_lay,                   & !
          p_lev,                   & ! 
          t_lay,                   & !
          gas_concentrations,      & !
          sw_optical_props_clrsky, & !
          Interstitial%toa_src_sw))                  !
 
+    ! Scale incident flux
+    Interstitial%toa_src_sw = Interstitial%toa_src_sw*solcon/sum(Interstitial%toa_src_sw)
+
     ! Compute boundary-condition (only for low ceiling models, set in GFS_typedefs.F90)
     !call check_error_msg('rrtmgp_sw_gas_optics_run',compute_bc(&
     !     sw_gas_props,       & ! IN  -

diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta
@@ -155,6 +155,15 @@
   type = logical
   intent = in
   optional = F
+[solcon]
+  standard_name = solar_constant
+  long_name = solar constant
+  units = W m-2
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [errmsg]
   standard_name = ccpp_error_message
   long_name = error message for error handling in CCPP