create a single_loop_alternate for hr4_test3

HelinWei-NOAA · Apr 4, 2024 · 9e5eeb8 · 9e5eeb8
1 parent 0ff86ac
commit 9e5eeb8
Showing 1 changed file with 15 additions and 18 deletions.
diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90
@@ -4052,11 +4052,6 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
 
         end if
 
-! prepare for longwave rad.
-
-        air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4  
-        cir = (2.-emv*(1.-emg))*emv*sb
-!
        if(opt_sfc == 4) then
 
         gdx  = sqrt(garea1)
@@ -4203,6 +4198,11 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
         end if
      end if
 
+! prepare for longwave rad.
+
+        air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4  
+        cir = (2.-emv*(1.-emg))*emv*sb
+
 ! prepare for sensible heat flux above veg.
 
         cah  = 1./rahc
@@ -4265,7 +4265,7 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
 
 ! update vegetation surface temperature
         tv  = tv + dtv
-!        tah = ata + bta*tv               ! canopy air t; update here for consistency
+        tah = ata + bta*tv               ! canopy air t; update here for consistency
 
 ! for computing m-o length in the next iteration
         h  = rhoair*cpair*(tah - sfctmp) /rahc        
@@ -4278,15 +4278,7 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
            qfx = (qsfc-qair)*rhoair*caw
         endif
 
-
-        if (liter == 1) then
-           exit loop1 
-        endif
-        if (iter >= 5 .and. abs(dtv) <= 0.01 .and. liter == 0) then
-           liter = 1
-        endif
-
-     end do loop1 ! end stability iteration
+! after canopy balance, do the under-canopy ground balance
 
 ! under-canopy fluxes and tg
 
@@ -4296,8 +4288,6 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
         cev = rhoair*cpair / (gammag*(rawg+rsurf))  ! barlage: change to ground v3.6
         cgh = 2.*df(isnow+1)/dzsnso(isnow+1)
 
-     loop2: do iter = 1, niterg
-
         t = tdc(tg)
         call esat(t, esatw, esati, dsatw, dsati)
         if (t .gt. 0.) then
@@ -4323,7 +4313,14 @@ subroutine vege_flux(parameters,nsnow   ,nsoil   ,isnow   ,vegtyp  ,veg     , &
         gh  = gh  + cgh*dtg
         tg  = tg  + dtg
 
-     end do loop2
+        if (liter == 1) then
+           exit loop1 
+        endif
+        if (iter >= 5 .and. abs(dtv) <= 0.01  .and. abs(dtg) <= 0.01 .and. liter == 0) then
+           liter = 1   ! if conditions are met, then do one final loop
+        endif
+
+     end do loop1
 
 !     tah = (cah*sfctmp + cvh*tv + cgh*tg)/(cah + cvh + cgh)