Merge pull request #973 from grantfirl/ufs-dev-PR6

UFS/dev PR#6
NCAR · Oct 26, 2022 · a089102 · a089102
2 parents 2550352 + 15e44c8
commit a089102
Showing 1 changed file with 27 additions and 0 deletions.
diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90
@@ -1043,6 +1043,20 @@ subroutine lsm_ruc_run                                            & ! inputs
         z0_lnd(i,j)  = z0rl_lnd(i)/100.
         znt_lnd(i,j) = z0rl_lnd(i)/100.
 
+        ! Workaround needed for subnormal numbers.  This should be
+        ! done after all other sanity checks, in case a sanity check
+        ! results in subnormal numbers.
+        !
+        ! This bug was caught by the UFS gfortran debug-mode
+        ! regression tests, and the fix is necessary to pass those
+        ! tests.
+        if(abs(snowh_lnd(i,j))<1e-20) then
+          snowh_lnd(i,j)=0
+        endif
+        if(abs(sneqv_lnd(i,j))<1e-20) then
+          sneqv_lnd(i,j)=0
+        endif
+
         if(debug_print) then
           if(me==0 ) then
             write (0,*)'before LSMRUC for land'
@@ -1360,6 +1374,19 @@ subroutine lsm_ruc_run                                            & ! inputs
         z0_ice(i,j)  = z0rl_ice(i)/100.
         znt_ice(i,j) = z0rl_ice(i)/100.
 
+        ! Workaround needed for subnormal numbers.  This should be
+        ! done after all other sanity checks, in case a sanity check
+        ! results in subnormal numbers.
+        !
+        ! Although this bug has not been triggered yet, it is expected
+        ! to be, like the _lnd variants many lines up from here.
+        if(abs(snowh_ice(i,j))<1e-20) then
+          snowh_ice(i,j)=0
+        endif
+        if(abs(sneqv_ice(i,j))<1e-20) then
+          sneqv_ice(i,j)=0
+        endif
+
 !> - Call RUC LSM lsmruc() for ice.
       call lsmruc(                                                           &
      &          delt, flag_init, lsm_cold_start, kdt, iter, nsoil,           &