Skip to content

Revert "Lsm upgrades mynn for p8c" #22

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
HelinWei-NOAA merged 1 commit into from
Mar 24, 2022
Merged

Revert "Lsm upgrades mynn for p8c" #22

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
101 changes: 4 additions & 97 deletions physics/module_sf_noahmp_glacier.f90
View file
Open in desktop
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