Added more safeguards against out-of-bounds temperature to GP inputs.

dustinswales · dustinswales · commit 6961b1054603 · 2021-05-09T23:50:22.000Z
diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90
@@ -98,8 +98,8 @@ end subroutine GFS_rrtmgp_pre_init
 !!
   subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr,     &
        xlat, xlon,  prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt,     &
-       con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa,      & 
-       qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg)
+       con_epsqs, minGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, &
+       tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg)
     
     ! Inputs   
     integer, intent(in)    :: &
@@ -112,6 +112,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f
     	 lslwr                ! Call LW radiation
     real(kind_phys), intent(in) :: &
          minGPtemp,         & ! Minimum temperature allowed in RRTMGP.
+         maxGPtemp,         & ! Maximum temperature allowed in RRTMGP.
          minGPpres,         & ! Minimum pressure allowed in RRTMGP.
          fhswr,             & ! Frequency of SW radiation call.
          fhlwr                ! Frequency of LW radiation call.
@@ -208,11 +209,14 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f
           if (t_lay(iCol,iLay) .le. minGPtemp) then
              t_lay(iCol,iLay) = minGPtemp + epsilon(minGPtemp)
           endif
+          if (t_lay(iCol,iLay) .ge. maxGPtemp) then
+             t_lay(iCol,iLay) = maxGPtemp - epsilon(maxGPtemp)
+          endif
        enddo
     enddo
 
     ! Temperature at layer-interfaces          
-    call cmp_tlev(nCol,nLev,minGPpres,p_lay,t_lay,p_lev,tsfc,t_lev)
+    call cmp_tlev(nCol,nLev,minGPpres,minGPtemp,maxGPtemp,p_lay,t_lay,p_lev,tsfc,t_lev)
 
     ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. 
     ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, 
@@ -273,7 +277,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f
     ! #######################################################################################
     ! Setup surface ground temperature and ground/air skin temperature if required.
     ! #######################################################################################
-    tsfg(1:NCOL) = tsfc(1:NCOL)
+    tsfg(1:NCOL) = t_lev(1:NCOL,iSFC)
     tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)
 
   end subroutine GFS_rrtmgp_pre_run
diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta
@@ -239,6 +239,15 @@
   kind = kind_phys
   intent = in
   optional = F
+[maxGPtemp]
+  standard_name = maximum_temperature_in_RRTMGP
+  long_name = maximum temperature allowed in RRTMGP
+  units = K
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [raddt]
   standard_name = time_step_for_radiation
   long_name = radiation time step
diff --git a/physics/dcyc2.f b/physics/dcyc2.f
@@ -178,7 +178,7 @@ subroutine dcyc2t3_run                                            &
      &       sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu,                   &
      &       sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd,                   &
      &       im, levs, deltim, fhswr,                                   &
-     &       dry, icy, wet,                                             &
+     &       dry, icy, wet, minGPtemp, maxGPtemp,                       &
      &       minGPpres, use_LW_jacobian, sfculw, fluxlwUP_jac,          &
      &       t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN,    &
      &       pert_radtend, do_sppt,ca_global,                           &
@@ -216,7 +216,8 @@ subroutine dcyc2t3_run                                            &
       logical, intent(in) :: use_LW_jacobian, pert_radtend
       logical, intent(in) :: do_sppt,ca_global
       real(kind=kind_phys),   intent(in) :: solhr, slag, cdec, sdec,    &
-     &                                      deltim, fhswr, minGPpres
+     &                                      deltim, fhswr, minGPpres,   &
+     &                                      minGPtemp, maxGPtemp
 
       real(kind=kind_phys), dimension(:), intent(in) ::                 &
      &      sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw,            &
@@ -372,8 +373,8 @@ subroutine dcyc2t3_run                                            &
          !
          ! Compute temperatute at level interfaces.
          !
-         call cmp_tlev(im, levs, minGPpres, p_lay, t_lay, p_lev, tsfc,  &
-     &        t_lev2)
+         call cmp_tlev(im, levs, minGPpres, minGPtemp, maxGPtemp, p_lay,& 
+     &                  t_lay, p_lev, tsfc, t_lev2)
 
          !
          ! Adjust up/downward fluxes (at layer interfaces).
diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta
@@ -353,6 +353,24 @@
   type = logical
   intent = in
   optional = F
+[minGPtemp]
+  standard_name = minimum_temperature_in_RRTMGP
+  long_name = minimum temperature allowed in RRTMGP
+  units = K
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
+[maxGPtemp]
+  standard_name = maximum_temperature_in_RRTMGP
+  long_name = maximum temperature allowed in RRTMGP
+  units = K
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = in
+  optional = F
 [minGPpres]
   standard_name = minimum_pressure_in_RRTMGP
   long_name = minimum pressure allowed in RRTMGP
diff --git a/physics/radiation_tools.F90 b/physics/radiation_tools.F90
@@ -2,20 +2,16 @@ module radiation_tools
   use machine, only: &
        kind_phys                   ! Working type
   implicit none
-
-  real(kind_phys) :: &
-       rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP
-       rrtmgp_minT    ! Minimum temperature allowed in RRTMGP
 contains
 
   ! ######################################################################################### 
   ! ######################################################################################### 
-  subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev)
+  subroutine cmp_tlev(nCol,nLev,minP,minT,maxT,p_lay,t_lay,p_lev,tsfc,t_lev)
     ! Inputs
     integer, intent(in) :: &
          nCol,nLev
     real(kind_phys),intent(in) :: &
-         minP
+         minP,minT,maxT
     real(kind_phys),dimension(nCol),intent(in) :: &
          tsfc
     real(kind_phys),dimension(nCol,nLev),intent(in) :: &
@@ -78,6 +74,18 @@ subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev)
        t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA)
     endif
 
+    ! Bound temperature at layer interfaces
+    do iCol=1,NCOL
+       do iLay=1,nLev+1
+          if (t_lev(iCol,iLay) .le. minT) then
+             t_lev(iCol,iLay) = minT + epsilon(minT)
+          endif
+          if (t_lev(iCol,iLay) .ge. maxT) then
+             t_lev(iCol,iLay) = maxT - epsilon(maxT)
+          endif
+       enddo
+    enddo
+
   end subroutine cmp_tlev
 
   ! #########################################################################################
diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90
@@ -76,7 +76,7 @@ module rrtmgp_lw_gas_optics
 !! \htmlinclude rrtmgp_lw_gas_optics_init.html
 !!
   subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm,        &
-       mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, errmsg, errflg)
+       mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, maxGPtemp, errmsg, errflg)
 
     ! Inputs
     type(ty_gas_concs), intent(inout) :: &
@@ -96,6 +96,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom
          errflg              ! CCPP error code
     real(kind_phys), intent(out) :: &
          minGPtemp,        & ! Minimum temperature allowed by RRTMGP.
+         maxGPtemp,        & ! Maximum temperature allowed by RRTMG.
          minGPpres           ! Minimum pressure allowed by RRTMGP. 
 
     ! Local variables
@@ -450,6 +451,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom
     ! temperature (GFS_rrtmgp_pre.F90)
     minGPpres = lw_gas_props%get_press_min()
     minGPtemp = lw_gas_props%get_temp_min() 
+    maxGPtemp = lw_gas_props%get_temp_max()
 
   end subroutine rrtmgp_lw_gas_optics_init
 
diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta
@@ -92,6 +92,15 @@
   kind = kind_phys
   intent = out
   optional = F
+[maxGPtemp]
+  standard_name = maximum_temperature_in_RRTMGP
+  long_name = maximum temperature allowed in RRTMGP
+  units = K
+  dimensions = ()
+  type = real
+  kind = kind_phys
+  intent = out
+  optional = F
 
 ########################################################################
 [ccpp-arg-table]
