Skip to content

Commit

Permalink
Merge pull request NCAR#22 from HelinWei-NOAA/revert-20-lsm_upgrades_…
Browse files Browse the repository at this point in the history 
…MYNN_for_p8c

Revert "Lsm upgrades mynn for p8c"
  • Loading branch information
@HelinWei-NOAA
HelinWei-NOAA authored Mar 24, 2022
2 parents 02a4c05 + 7a16e21 commit 2150803
Show file tree
Hide file tree
Showing 4 changed files with 24 additions and 1,704 deletions.
101 changes: 4 additions & 97 deletions physics/module_sf_noahmp_glacier.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@ module noahmp_glacier_globals

use machine , only : kind_phys
use sfc_diff, only : stability
use module_sf_noahmplsm, only : sfcdif4

implicit none

Expand Down Expand Up @@ -123,9 +122,7 @@ subroutine noahmp_glacier (&
iloc ,jloc ,cosz ,nsnow ,nsoil ,dt , & ! in : time/space/model-related
sfctmp ,sfcprs ,uu ,vv ,q2 ,soldn , & ! in : forcing
prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing
thsfc_loc ,prslkix ,prsik1x ,prslk1x , &
psfc ,pblhx ,iz0tlnd ,itime , &
sigmaf1 ,garea1 ,psi_opt , & ! in :
thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & ! in :
qsnow ,sneqvo ,albold ,cm ,ch ,isnow , & ! in/out :
sneqv ,smc ,zsnso ,snowh ,snice ,snliq , & ! in/out :
tg ,stc ,sh2o ,tauss ,qsfc , & ! in/out :
Expand All @@ -152,8 +149,6 @@ subroutine noahmp_glacier (&
real (kind=kind_phys) , intent(in) :: cosz !< cosine solar zenith angle [0-1]
integer , intent(in) :: nsnow !< maximum no. of snow layers
integer , intent(in) :: nsoil !< no. of soil layers
integer , intent(in) :: psi_opt

real (kind=kind_phys) , intent(in) :: dt !< time step [sec]
real (kind=kind_phys) , intent(in) :: sfctmp !< surface air temperature [k]
real (kind=kind_phys) , intent(in) :: sfcprs !< pressure (pa)
Expand All @@ -171,12 +166,6 @@ subroutine noahmp_glacier (&
real (kind=kind_phys) , intent(in) :: prslkix !< pressure (pa)
real (kind=kind_phys) , intent(in) :: prsik1x !< pressure (pa)
real (kind=kind_phys) , intent(in) :: prslk1x !< pressure (pa)

real (kind=kind_phys) , intent(in) :: psfc ! surface pressure
real (kind=kind_phys) , intent(in) :: pblhx ! pbl height
integer , intent(in) :: iz0tlnd !
integer , intent(in) :: itime !< timestep

real (kind=kind_phys) , intent(in) :: sigmaf1 !< areal fractional cover of green vegetation
real (kind=kind_phys) , intent(in) :: garea1 !< area of the grid cell

Expand Down Expand Up @@ -285,7 +274,6 @@ subroutine noahmp_glacier (&
vv ,solad ,solai ,cosz ,zlvl , & !in
tbot ,zbot ,zsnso ,dzsnso ,sigmaf1 ,garea1 , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x , & !in
psfc ,pblhx ,iz0tlnd ,itime ,psi_opt , &
tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout
smc ,snice ,snliq ,albold ,cm ,ch , & !inout
#ifdef CCPP
Expand Down Expand Up @@ -417,7 +405,6 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair
vv ,solad ,solai ,cosz ,zref , & !in
tbot ,zbot ,zsnso ,dzsnso ,sigmaf1 ,garea1 , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x , & !in
psfc ,pblhx ,iz0tlnd ,itime ,psi_opt , &
tg ,stc ,snowh ,sneqv ,sneqvo ,sh2o , & !inout
smc ,snice ,snliq ,albold ,cm ,ch , & !inout
#ifdef CCPP
Expand All @@ -440,8 +427,6 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair
! inputs
integer , intent(in) :: nsnow !< maximum no. of snow layers
integer , intent(in) :: nsoil !< number of soil layers
integer , intent(in) :: psi_opt

integer , intent(in) :: isnow !< actual no. of snow layers
real (kind=kind_phys) , intent(in) :: dt !< time step [sec]
real (kind=kind_phys) , intent(in) :: qsnow !< snowfall on the ground (mm/s)
Expand All @@ -466,12 +451,6 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair
real (kind=kind_phys) , intent(in) :: prslkix ! in exner function
real (kind=kind_phys) , intent(in) :: prsik1x ! in exner function
real (kind=kind_phys) , intent(in) :: prslk1x ! in exner function

real (kind=kind_phys) , intent(in) :: pblhx !< PBL height (m)
real (kind=kind_phys) , intent(in) :: psfc !< surface pressure
integer , intent(in) :: iz0tlnd !< z0t option
integer , intent(in) :: itime !< integration time

real (kind=kind_phys) , intent(in) :: sigmaf1 !< areal fractional cover of green vegetation
real (kind=kind_phys) , intent(in) :: garea1 !< area of the grid cell

Expand Down Expand Up @@ -582,9 +561,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair
zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in
ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in
eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x , &
psfc ,pblhx ,iz0tlnd ,itime ,uu ,vv , &
sigmaf1 ,garea1 ,psi_opt , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & !in
#ifdef CCPP
cm ,ch ,tg ,qsfc ,errmsg ,errflg , & !inout
#else
Expand Down Expand Up @@ -1020,9 +997,7 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
zlvl ,zpd ,qair ,sfctmp ,rhoair ,sfcprs , & !in
ur ,gamma ,rsurf ,lwdn ,rhsur ,smc , & !in
eair ,stc ,sag ,snowh ,lathea ,sh2o , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x , &
psfc ,pblhx ,iz0tlnd ,itime ,uu ,vv , &
sigmaf1 ,garea1 ,psi_opt , & !in
thsfc_loc ,prslkix ,prsik1x ,prslk1x ,sigmaf1 ,garea1 , & !in
#ifdef CCPP
cm ,ch ,tgb ,qsfc ,errmsg ,errflg , & !inout
#else
Expand All @@ -1045,8 +1020,6 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
! input
integer, intent(in) :: nsnow !< maximum no. of snow layers
integer, intent(in) :: nsoil !< number of soil layers
integer, intent(in) :: psi_opt

real (kind=kind_phys), intent(in) :: emg !< ground emissivity
integer, intent(in) :: isnow !< actual no. of snow layers
real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !< thermal conductivity of snow/soil (w/m/k)
Expand Down Expand Up @@ -1075,14 +1048,6 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
real (kind=kind_phys), intent(in) :: prslkix ! in exner function
real (kind=kind_phys), intent(in) :: prsik1x ! in exner function
real (kind=kind_phys), intent(in) :: prslk1x ! in exner function

real (kind=kind_phys) , intent(in) :: pblhx !<
real (kind=kind_phys) , intent(in) :: psfc !<
integer , intent(in) :: iz0tlnd !<
integer , intent(in) :: itime !< integration time
real (kind=kind_phys) , intent(in) :: uu !<
real (kind=kind_phys) , intent(in) :: vv !<

real (kind=kind_phys), intent(in) :: sigmaf1 !
real (kind=kind_phys), intent(in) :: garea1 !

Expand Down Expand Up @@ -1130,19 +1095,11 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
integer :: iter !< iteration index
real (kind=kind_phys) :: z0h !< roughness length, sensible heat, ground (m)

real (kind=kind_phys) :: qfx
real (kind=kind_phys) :: cq2 !< surface exchange at 2m


real(kind=kind_phys) :: rb1i ! bulk richardson #
real(kind=kind_phys) :: fm10i ! fm10 over land ice

real(kind=kind_phys) :: stress1i! wind stress m2 S-2

real(kind=kind_phys) :: wspd1i
real(kind=kind_phys) :: flhc1i
real(kind=kind_phys) :: flqc1i

real(kind=kind_phys) :: tv1i ! virtual potential temp @ ref level

real(kind=kind_phys) :: thv1i ! virtual potential temp @ ref level
Expand Down Expand Up @@ -1192,10 +1149,6 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso

h = 0.

fh2 = 0.
qfx = 0.


! the following only applies to opt_sfc =3, opt_sfc = 1 still done its old way

snwd = snowh*1000.0
Expand Down Expand Up @@ -1241,10 +1194,8 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
tem2 = max(sigmaf1, 0.1_kind_phys)
zvfun1= sqrt(tem1 * tem2)
gdx=sqrt(garea1)

if(opt_sfc == 1 .or. opt_sfc == 2 .or. opt_sfc == 4) then !Add option for sfc scheme,use '1' for both '1'/'2'
if(opt_sfc == 1 .or. opt_sfc == 2) then !Add option for sfc scheme,use '1' for both '1'/'2'
loop3: do iter = 1, niterb ! begin stability iteration
if(opt_sfc == 1 .or. opt_sfc == 2) then

! for now, only allow sfcdif1 until others can be fixed

Expand All @@ -1260,45 +1211,8 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
#ifdef CCPP
if (errflg /= 0) return
#endif
endif

if(opt_sfc == 4) then

call sfcdif4(1 ,1 ,uu ,vv ,sfctmp , & !allow location for use in the driver
sfcprs ,psfc ,pblhx ,gdx ,z0m , &
itime ,snwd ,1 ,psi_opt, &
tgb ,qair ,zlvl ,iz0tlnd,qsfc , & ! use zlvli?
h ,qfx ,cm ,ch ,ch2 , & ! ch2 = cq2 most of times
cq2 ,moz ,fv ,rb1i, fm, fh, &
stress1i,fm10i ,fh2 , wspd1i ,flhc1i ,flqc1i) ! some are for use in the driver call


! Undo the multiplication by windspeed that SFCDIF4
! applies to exchange coefficients CH and CM:

ch = ch / wspd1i
cm = cm / wspd1i
ch2 = ch2 / wspd1i
cq2 = cq2 / wspd1i

if(snwd > 0.) then
cm = min(0.01,cm)
ch = min(0.01,ch)
ch2 = min(0.01,ch2)
cq2 = min(0.01,cq2)
end if

endif ! 4


ramb = max(1.,1./(cm*ur))
rahb = max(1.,1./(ch*ur))

if(opt_sfc == 4) then
ramb = max(1.,1./(cm*wspd1i) )
rahb = max(1.,1./(ch*wspd1i) )
endif

rawb = rahb

! es and d(es)/dt evaluated at tg
Expand Down Expand Up @@ -1350,7 +1264,6 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
estg = esati
end if
qsfc = 0.622*(estg*rhsur)/(sfcprs-0.378*(estg*rhsur))
qfx = (qsfc-qair)*cev*gamma/cpair

end do loop3 ! end stability iteration
end if
Expand Down Expand Up @@ -1449,12 +1362,6 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso
! 2m air temperature
ehb2 = fv*vkc/(log((2.+z0h)/z0h)-fh2)
cq2b = ehb2

if (opt_sfc == 4) then
ehb2 = ch2 * wspd1i ! need conductance,z0h from sfcdif4
cq2b = cq2 * wspd1i ! conductance
endif

if (ehb2.lt.1.e-5 ) then
t2mb = tgb
q2b = qsfc
Expand Down
Loading

0 comments on commit 2150803

Please sign in to comment.