Merge pull request #2051 from slevis-lmwg/nag_test_fixes

Fixes for failing nag tests

doc/ChangeLog

@@ -1,4 +1,63 @@
 ===============================================================
+Tag name: ctsm5.1.dev139
+Originator(s): slevis (Samuel Levis)
+Date: Fri Aug 25 16:47:45 MDT 2023
+One-line Summary: Fix problems uncovered by nag -nan tests
+
+Purpose and description of changes
+----------------------------------
+
+ Fix problems uncovered by adding the -nan compilation flag for the Nag
+ compiler.
+
+
+Significant changes to scientifically-supported configurations
+--------------------------------------------------------------
+
+Does this tag change answers significantly for any of the following physics configurations?
+(Details of any changes will be given in the "Answer changes" section below.)
+
+    [Put an [X] in the box for any configuration with significant answer changes.]
+
+[ ] clm5_1
+
+[ ] clm5_0
+
+[ ] ctsm5_0-nwp
+
+[ ] clm4_5
+
+
+Bugs fixed or introduced
+------------------------
+CTSM issues fixed (include CTSM Issue #):
+ Makes progress on issue #1994 (same title)
+
+
+Testing summary:
+----------------
+
+ [PASS means all tests PASS; OK means tests PASS other than expected fails.]
+
+  regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing):
+
+    cheyenne ---- OK
+    izumi ------- PASS
+
+
+Answer changes
+--------------
+
+Changes answers relative to baseline: No
+
+
+Other details
+-------------
+Pull Requests that document the changes (include PR ids):
+ https://github.com/ESCOMP/ctsm/pull/2051
+
+===============================================================
+===============================================================
 Tag name: ctsm5.1.dev138
 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310)
 Date: Fri Aug 25 14:44:22 MDT 2023

doc/ChangeSum

@@ -1,5 +1,6 @@
 Tag                   Who      Date  Summary
 ============================================================================================================================
+    ctsm5.1.dev139   slevis 08/28/2023 Fix problems uncovered by nag -nan tests
     ctsm5.1.dev138   slevis 08/25/2023 Refactor max_patch_per_col and maxsoil_patches loops
     ctsm5.1.dev137   slevis 08/23/2023 Surface roughness modifications
     ctsm5.1.dev136 multiple 08/22/2023 Change order of history fields to improve performance on derecho

src/biogeochem/CNVegNitrogenStateType.F90

@@ -1145,7 +1145,6 @@ subroutine Summary_nitrogenstate(this, bounds, num_soilc, filter_soilc, num_soil
             this%totn_p2c_col(bounds%begc:bounds%endc))
     end if
 
-
   end subroutine Summary_nitrogenstate
 
   !-----------------------------------------------------------------------

src/biogeochem/NutrientCompetitionFlexibleCNMod.F90

@@ -1365,7 +1365,6 @@ subroutine calc_plant_nitrogen_demand(this, bounds,                           &
          frootn                => cnveg_nitrogenstate_inst%frootn_patch             , & ! Input:  [real(r8) (:)   ]  (gN/m2) fine root N
          livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:)   ]
          sminn_vr              => soilbiogeochem_nitrogenstate_inst%sminn_vr_col    , & ! Input:  [real(r8) (:,:) ]  (gN/m3) soil mineral N
-         btran                 => energyflux_inst%btran_patch                       , & ! Input: [real(r8) (:)    ]  transpiration wetness factor (0 to 1)
          t_scalar              => soilbiogeochem_carbonflux_inst%t_scalar_col         & ! Input:  [real(r8) (:,:) ]  soil temperature scalar for decomp
          )
 

src/biogeophys/FrictionVelocityMod.F90

@@ -750,10 +750,13 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, &
     real(r8) , intent(in)    :: ur      ( lbn: )         ! wind speed at reference height [m/s] [lbn:ubn]
     real(r8) , intent(in)    :: um      ( lbn: )         ! wind speed including the stablity effect [m/s] [lbn:ubn]
     real(r8) , intent(out)   :: ustar   ( lbn: )         ! friction velocity [m/s] [lbn:ubn]
-    real(r8) , intent(out)   :: temp1   ( lbn: )         ! relation for potential temperature profile [lbn:ubn]
-    real(r8) , intent(out)   :: temp12m ( lbn: )         ! relation for potential temperature profile applied at 2-m [lbn:ubn]
-    real(r8) , intent(out)   :: temp2   ( lbn: )         ! relation for specific humidity profile [lbn:ubn]
-    real(r8) , intent(out)   :: temp22m ( lbn: )         ! relation for specific humidity profile applied at 2-m [lbn:ubn]
+    ! temp1, temp12m, temp2, temp22m are "inout" rather than "out" to
+    ! prevent returning nan when the code returns from this subroutine
+    ! before assigning values to these variables
+    real(r8) , intent(inout) :: temp1   ( lbn: )         ! relation for potential temperature profile [lbn:ubn]
+    real(r8) , intent(inout) :: temp12m ( lbn: )         ! relation for potential temperature profile applied at 2-m [lbn:ubn]
+    real(r8) , intent(inout) :: temp2   ( lbn: )         ! relation for specific humidity profile [lbn:ubn]
+    real(r8) , intent(inout) :: temp22m ( lbn: )         ! relation for specific humidity profile applied at 2-m [lbn:ubn]
     real(r8) , intent(inout) :: fm      ( lbn: )         ! diagnose 10m wind (DUST only) [lbn:ubn]
     logical  , intent(in), optional :: landunit_index   ! optional argument that defines landunit or pft level
     !

src/biogeophys/PhotosynthesisMod.F90

@@ -2266,7 +2266,10 @@ subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,&
     real(r8), intent(in) :: cair               ! Atmospheric CO2 partial pressure (Pa)
     real(r8), intent(in) :: oair               ! Atmospheric O2 partial pressure (Pa)
     integer,  intent(in) :: p, iv, c           ! pft, c3/c4, and column index
-    real(r8), intent(out) :: gs_mol            ! leaf stomatal conductance (umol H2O/m**2/s)
+    ! gs_mol is "inout" rather than "out" to
+    ! prevent returning nan when the code returns from this subroutine
+    ! before assigning a value to this variable
+    real(r8), intent(inout) :: gs_mol          ! leaf stomatal conductance (umol H2O/m**2/s)
     integer,  intent(out) :: iter              !number of iterations used, for record only
     type(atm2lnd_type)  , intent(in)    :: atm2lnd_inst
     type(photosyns_type), intent(inout) :: photosyns_inst
@@ -2378,7 +2381,10 @@ subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,&
     real(r8), intent(in) :: oair              ! Atmospheric O2 partial pressure (Pa)
     real(r8), intent(in) :: rh_can            ! inside canopy relative humidity
     integer,  intent(in) :: ip, iv, ic        ! pft, c3/c4, and column index
-    real(r8), intent(out) :: gs_mol           ! leaf stomatal conductance (umol H2O/m**2/s)
+    ! gs_mol is "inout" rather than "out" to
+    ! prevent returning nan when the code returns from this subroutine
+    ! before assigning a value to this variable
+    real(r8), intent(inout) :: gs_mol         ! leaf stomatal conductance (umol H2O/m**2/s)
     type(atm2lnd_type)  , intent(in)    :: atm2lnd_inst
     type(photosyns_type), intent(inout) :: photosyns_inst
     !
@@ -2568,7 +2574,10 @@ subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,&
     real(r8)             , intent(in)    :: rh_can   ! canopy air realtive humidity
     integer              , intent(in)    :: p, iv, c ! pft, vegetation type and column indexes
     real(r8)             , intent(out)   :: fval     ! return function of the value f(ci)
-    real(r8)             , intent(out)   :: gs_mol   ! leaf stomatal conductance (umol H2O/m**2/s)
+    ! gs_mol is "inout" rather than "out" to
+    ! prevent returning nan when the code returns from this subroutine
+    ! before assigning a value to this variable
+    real(r8)             , intent(inout) :: gs_mol   ! leaf stomatal conductance (umol H2O/m**2/s)
     type(atm2lnd_type)   , intent(in)    :: atm2lnd_inst
     type(photosyns_type) , intent(inout) :: photosyns_inst
     !
@@ -2706,7 +2715,6 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, &
     use clm_varpar        , only : nlevsoi
     use pftconMod         , only : nbrdlf_dcd_tmp_shrub, npcropmin
     use ColumnType        , only : col
-    use shr_infnan_mod    , only : shr_infnan_isnan
 
     !
     ! !ARGUMENTS:
@@ -2724,7 +2732,7 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, &
     real(r8)               , intent(in)    :: leafn( bounds%begp: )          ! leaf N (gN/m2)
     real(r8)               , intent(out)   :: bsun( bounds%begp: )           ! sunlit canopy transpiration wetness factor (0 to 1)
     real(r8)               , intent(out)   :: bsha( bounds%begp: )           ! shaded canopy transpiration wetness factor (0 to 1)
-    real(r8)               , intent(out)   :: btran( bounds%begp: )          ! transpiration wetness factor (0 to 1) [pft]
+    real(r8)               , intent(inout) :: btran( bounds%begp: )          ! transpiration wetness factor (0 to 1) [pft]
     real(r8)               , intent(in)    :: froot_carbon( bounds%begp: )    ! fine root carbon (gC/m2) [pft]   
     real(r8)               , intent(in)    :: croot_carbon( bounds%begp: )    ! live coarse root carbon (gC/m2) [pft]   
 
@@ -3477,6 +3485,7 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, &
                else
                   gsminsun = nan
                   gsminsha = nan
+                  call endrun( 'ERROR:: Photosynthesis::PhotosynthesisHydraulicStress must choose stomatalcond_mtd method' )
                end if
                call calcstress(p,c,vegwp(p,:),bsun(p),bsha(p),gb_mol(p),gsminsun, gsminsha, &
                     qsatl(p),qaf(p), atm2lnd_inst,canopystate_inst,waterdiagnosticbulk_inst, &
@@ -4064,8 +4073,11 @@ subroutine brent_PHS(xsun, x1sun, x2sun, f1sun, f2sun, xsha, x1sha, x2sha, f1sha
     real(r8), intent(in)    :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s)
     real(r8), intent(in)    :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2)
     real(r8), intent(in)    :: rh_can               ! inside canopy relative humidity
-    real(r8), intent(out)   :: gs_mol_sun           ! sunlit leaf stomatal conductance (umol H2O/m**2/s)
-    real(r8), intent(out)   :: gs_mol_sha           ! shaded leaf stomatal conductance (umol H2O/m**2/s)
+    ! gs_mol_s* are "inout" rather than "out" to
+    ! prevent returning nan when the code returns from this subroutine
+    ! before assigning values to these variables
+    real(r8), intent(inout) :: gs_mol_sun           ! sunlit leaf stomatal conductance (umol H2O/m**2/s)
+    real(r8), intent(inout) :: gs_mol_sha           ! shaded leaf stomatal conductance (umol H2O/m**2/s)
     real(r8), intent(inout) :: bsun                 ! sunlit canopy transpiration wetness factor (0 to 1)
     real(r8), intent(inout) :: bsha                 ! shaded canopy transpiration wetness factor (0 to 1)
     real(r8), intent(in)    :: qsatl                ! leaf specific humidity [kg/kg]
@@ -4344,6 +4356,7 @@ subroutine ci_func_PHS(x,cisun, cisha, fvalsun, fvalsha, p, iv, c, bsun, bsha, b
           gs_mol_sun = bbb(p)
        else
           gs_mol_sun = nan
+          call endrun( 'ERROR:: Photosynthesis::ci_func_PHS must choose stomatalcond_mtd method' )
        end if
        gs_mol_sun = max( bsun*gs_mol_sun, 1._r8)
        fvalsun = 0._r8  ! really tho? zqz
@@ -4355,6 +4368,7 @@ subroutine ci_func_PHS(x,cisun, cisha, fvalsun, fvalsha, p, iv, c, bsun, bsha, b
           gs_mol_sha = bbb(p)
        else
           gs_mol_sha = nan
+          call endrun( 'ERROR:: Photosynthesis::ci_func_PHS must choose stomatalcond_mtd method' )
        end if
        gs_mol_sha = max( bsha*gs_mol_sha, 1._r8)
        fvalsha = 0._r8

src/main/clm_initializeMod.F90

@@ -340,7 +340,7 @@ subroutine initialize2(ni,nj)
     end if
 
     ! Pass model timestep info to FATES
-    call CLMFatesTimesteps()
+    if (use_fates) call CLMFatesTimesteps()
 
     ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly)
     call t_startf('init_orbd')

src/main/surfrdUtilsMod.F90

@@ -45,7 +45,7 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto)
     character(len=*), intent(in) :: name         ! name of array
     character(len=*), intent(in) :: caller       ! identifier of caller, for more meaningful error messages
     integer, optional, intent(out):: ier         ! Return an error code rather than abort
-    real(r8), optional, intent(out):: sumto(lb:)  ! The value the array should sum to (1.0 if not provided)
+    real(r8), optional, intent(in):: sumto(lb:)  ! The value the array should sum to (1.0 if not provided)
     !
     ! !LOCAL VARIABLES:
     logical :: found
@@ -63,7 +63,7 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto)
     if( present(ier) ) ier = 0
     found = .false.
 
-    do nl = lbound(arr, 1), ub
+    do nl = lb, ub
        if (abs(sum(arr(nl,:)) - TotalSum(nl)) > eps) then
           found = .true.
           nindx = nl