Skip to content

Add lsm_cold_start flag (RUC LSM) and gwdps bugfix (combined) #834

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
grantfirl merged 5 commits into from
Feb 8, 2022
Merged

Add lsm_cold_start flag (RUC LSM) and gwdps bugfix (combined) #834

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
eff984d
change flag_for_restart to do_lsm_cold_start in GFS_phys_time_vary an…
grantfirl Oct 25, 2021
6dcc5e0
updated gwdphys.f
SMoorthi-emc Feb 2, 2022
355e391
Merge branch 'main' into RUC_LSM_SCM_support
grantfirl Feb 2, 2022
e87f7a5
bugfixes to pass ccpp_prebuild.py after merge with main
grantfirl Feb 2, 2022
c8d9656
Merge branch 'SM_Feb012022_PR' into RUC_LSM_SCM_support
grantfirl Feb 7, 2022
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
6 changes: 3 additions & 3 deletions physics/GFS_phys_time_vary.fv3.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,14 +79,14 @@ subroutine GFS_phys_time_vary_init (
albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, &
zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, &
smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, &
slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, &
slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, &
errmsg, errflg)

implicit none

! Interface variables
integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny
logical, intent(in) :: h2o_phys, iaerclm, flag_restart
logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start
integer, intent(in) :: idate(:)
real(kind_phys), intent(in) :: fhour
real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:)
Expand Down Expand Up @@ -394,7 +394,7 @@ subroutine GFS_phys_time_vary_init (

!--- For Noah MP or RUC LSMs: initialize four components of albedo for
!--- land and ice - not for restart runs
lsm_init: if (.not.flag_restart) then
lsm_init: if (lsm_cold_start) then
if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then
if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice'
do ix=1,im
Expand Down
6 changes: 3 additions & 3 deletions physics/GFS_phys_time_vary.fv3.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -874,9 +874,9 @@
type = real
kind = kind_phys
intent = in
[flag_restart]
standard_name = flag_for_restart
long_name = flag for restart (warmstart) or coldstart
[lsm_cold_start]
standard_name = do_lsm_cold_start
long_name = flag to signify LSM is cold-started
units = flag
dimensions = ()
type = logical
Expand Down
6 changes: 3 additions & 3 deletions physics/GFS_phys_time_vary.scm.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -73,14 +73,14 @@ subroutine GFS_phys_time_vary_init (
albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, &
zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, &
smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, &
slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, &
slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, &
errmsg, errflg)

implicit none

! Interface variables
integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny
logical, intent(in) :: h2o_phys, iaerclm, flag_restart
logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start
integer, intent(in) :: idate(:)
real(kind_phys), intent(in) :: fhour
real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:)
Expand Down Expand Up @@ -348,7 +348,7 @@ subroutine GFS_phys_time_vary_init (

!--- For Noah MP or RUC LSMs: initialize four components of albedo for
!--- land and ice - not for restart runs
lsm_init: if (.not.flag_restart) then
lsm_init: if (lsm_cold_start) then
if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then
if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice'
do ix=1,im
Expand Down
6 changes: 3 additions & 3 deletions physics/GFS_phys_time_vary.scm.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -874,9 +874,9 @@
type = real
kind = kind_phys
intent = in
[flag_restart]
standard_name = flag_for_restart
long_name = flag for restart (warmstart) or coldstart
[lsm_cold_start]
standard_name = do_lsm_cold_start
long_name = flag to signify LSM is cold-started
units = flag
dimensions = ()
type = logical
Expand Down
111 changes: 59 additions & 52 deletions physics/gwdps.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -323,7 +323,7 @@ subroutine gwdps_run( &
real(kind=kind_phys) wk(IM)
real(kind=kind_phys) bnv2lm(IM,KM),PE(IM),EK(IM),ZBK(IM),UP(IM)
real(kind=kind_phys) DB(IM,KM),ANG(IM,KM),UDS(IM,KM)
real(kind=kind_phys) ZLEN, DBTMP, Rtrm, PHIANG, CDmb, DBIM, ZR
real(kind=kind_phys) ZLEN, Rtrm, PHIANG, CDmb, DBIM, ZR, cdmbo4
real(kind=kind_phys) ENG0, ENG1
!
! Some constants
Expand Down Expand Up @@ -382,13 +382,13 @@ subroutine gwdps_run( &
real(kind=kind_phys) BNV2(IM,KM), TAUP(IM,KM+1), ri_n(IM,KM) &
&, TAUD(IM,KM), RO(IM,KM), VTK(IM,KM) &
&, VTJ(IM,KM), SCOR(IM), VELCO(IM,KM-1) &
&, bnv2bar(im)
&, bnv2bar(im), cdsigohp(im)
!
! real(kind=kind_phys) VELKO(KM-1)
integer kref(IM), kint(im), iwk(im), ipt(im)
! for lm mtn blocking
integer iwklm(im)
! integer kreflm(IM), iwklm(im)
! integer kreflm(IM), iwklm(im)
integer idxzb(im), ktrial, klevm1
!
real(kind=kind_phys) gor, gocp, fv, gr2, bnv, fr &
Expand All @@ -397,7 +397,7 @@ subroutine gwdps_run( &
&, rdelks, efact, coefm, gfobnv, onebg &
&, scork, rscor, hd, fro, rim, sira &
&, dtaux, dtauy, pkp1log, pklog &
&, cosang, sinang, cos2a, sin2a
&, cosang, sinang, cos2a, sin2a, oneocpdt
!
integer kmm1, kmm2, lcap, lcapp1, kbps, kbpsp1,kbpsm1 &
&, kmps, idir, nwd, i, j, k, klcap, kp1, kmpbl, npt, npr, kmll
Expand All @@ -413,11 +413,12 @@ subroutine gwdps_run( &
! cdmb = 192.0/float(IMX)
cdmb = 4.0 * 192.0/float(IMX)
if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1)
cdmbo4 = 0.25 * cdmb
!
npr = 0
DO I = 1, IM
DUSFC(I) = 0.
DVSFC(I) = 0.
DUSFC(I) = 0.
DVSFC(I) = 0.
ENDDO
!
DO K = 1, KM
Expand All @@ -428,30 +429,31 @@ subroutine gwdps_run( &
ENDDO
ENDDO
!
RDI = 1.0 / RD
onebg = 1.0 / g
GOR = G/RD
GR2 = G*GOR
GOCP = G/CP
FV = RV/RD - 1
RDI = 1.0 / RD
onebg = 1.0 / g
GOR = G/RD
GR2 = G*GOR
GOCP = G/CP
FV = RV/RD - 1
oneocpdt = 1.0 / (cp*deltim)
!
! NCNT = 0
KMM1 = KM - 1
KMM2 = KM - 2
LCAP = KM
LCAPP1 = LCAP + 1
!
RDXZB(:) = 0
!
IF ( NMTVR == 14) then
! ---- for lm and gwd calculation points
RDXZB(:) = 0
ipt = 0
npt = 0
DO I = 1,IM
IF (elvmax(i) > HMINMT .and. hprime(i) > hpmin) then
npt = npt + 1
ipt(npt) = i
if (ipr == i) npr = npt
npt = npt + 1
ipt(npt) = i
! if (lprnt .and. ipr == i) npr = npt
ENDIF
ENDDO
IF (npt == 0) RETURN ! No gwd/mb calculation done!
Expand Down Expand Up @@ -488,7 +490,8 @@ subroutine gwdps_run( &
!
DO I = 1, npt
j = ipt(i)
ELVMAX(J) = min (ELVMAX(J) + sigfac * hprime(j), hncrit)
ELVMAX(J) = min (ELVMAX(J) + sigfac * hprime(j), hncrit)
cdsigohp(i) = cdmbo4 * sigma(j) / hprime(j)
ENDDO
!
DO K = 1,KMLL
Expand Down Expand Up @@ -626,8 +629,8 @@ subroutine gwdps_run( &
! --- Wind projected on the line perpendicular to mtn range, U(Zb(K)).
! --- kenetic energy is at the layer Zb
! --- THETA ranges from -+90deg |_ to the mtn "largest topo variations"
UP(I) = UDS(I,K) * cos(ANG(I,K))
EK(I) = 0.5 * UP(I) * UP(I)
UP(I) = UDS(I,K) * cos(ANG(I,K))
EK(I) = 0.5 * UP(I) * UP(I)

! --- Dividing Stream lime is found when PE =exceeds EK.
IF (PE(I) >= EK(I)) THEN
Expand Down Expand Up @@ -732,9 +735,8 @@ subroutine gwdps_run( &
!! where \f$C_{d}\f$ is a specified constant, \f$\sigma\f$ is the
!! orographic slope.

DBTMP = 0.25 * CDmb * ZR * sigma(J) *
& MAX(cosANG, gamma(J)*sinANG) * ZLEN / hprime(J)
DB(I,K) = DBTMP * UDS(I,K)
DB(i,k) = CDsigohp(i) * ZR * RO(i,k) * ZLEN
& * MAX(cosANG, gamma(J)*sinANG) * uds(i,k)
!
! if(lprnt .and. i .eq. npr) then
! print *,' in gwdps_lmi.f 10 npt=',npt,i,j,idxzb(i)
Expand Down Expand Up @@ -770,7 +772,6 @@ subroutine gwdps_run( &
!
do i=1,npt
IDXZB(i) = 0
RDXZB(i) = 0.
enddo
ENDIF
!
Expand Down Expand Up @@ -884,9 +885,9 @@ subroutine gwdps_run( &
!
ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! Mean RO below kref
if (k < kref(i)-1) then
RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS(I)
RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS(I)
else
RDELKS = (PRSL(J,K)-PRSI(J,K+1)) * DELKS(I)
RDELKS = (PRSL(J,K)-PRSI(J,K+1)) * DELKS(I)
endif
BNV2bar(I) = BNV2bar(I) + BNV2(I,K) * RDELKS
ENDIF
Expand Down Expand Up @@ -1126,9 +1127,9 @@ subroutine gwdps_run( &
!!\f]
!! see eq.(4.6) in Kim and Arakawa (1995) \cite kim_and_arakawa_1995.

TEM2 = SQRT(ri_n(I,K))
TEM = 1. + TEM2 * FRO
RIM = ri_n(I,K) * (1.-FRO) / (TEM * TEM)
TEM2 = SQRT(ri_n(I,K))
TEM = 1. + TEM2 * FRO
RIM = ri_n(I,K) * (1.-FRO) / (TEM * TEM)
!
! CHECK STABILITY TO EMPLOY THE 'SATURATION HYPOTHESIS'
! OF LINDZEN (1981) EXCEPT AT TROPOSPHERIC DOWNSTREAM REGIONS
Expand Down Expand Up @@ -1168,7 +1169,7 @@ subroutine gwdps_run( &
! taup(i,km+1) = taup(i,km)
! ENDDO
!
IF(LCAP .LE. KM) THEN
IF(LCAP <= KM) THEN
DO KLCAP = LCAPP1, KM+1
DO I = 1,npt
SIRA = PRSI(ipt(I),KLCAP) / PRSI(ipt(I),LCAP)
Expand Down Expand Up @@ -1209,7 +1210,7 @@ subroutine gwdps_run( &
ENDDO
ENDDO
!
! if(lprnt .and. npr .gt. 0) then
! if(lprnt .and. npr > 0) then
! print *,' before A=',A(npr,:)
! print *,' before B=',B(npr,:)
! endif
Expand All @@ -1218,46 +1219,52 @@ subroutine gwdps_run( &
!! - Below the dividing streamline height (k < idxzb), mountain
!! blocking(\f$D_{b}\f$) is applied.
!! - Otherwise (k>= idxzb), orographic GWD (\f$\tau\f$) is applied.

DO K = 1,KM
DO I = 1,npt
J = ipt(i)
TAUD(I,K) = TAUD(I,K) * DTFAC(I)
DTAUX = TAUD(I,K) * XN(I)
DTAUY = TAUD(I,K) * YN(I)
ENG0 = 0.5*(U1(j,K)*U1(j,K)+V1(J,K)*V1(J,K))
! --- lm mb (*j*) changes overwrite GWD
if ( K < IDXZB(I) .AND. IDXZB(I) /= 0 ) then
DBIM = DB(I,K) / (1.+DB(I,K)*DELTIM)
A(J,K) = - DBIM * V1(J,K) + A(J,K)
B(J,K) = - DBIM * U1(J,K) + B(J,K)
ENG1 = ENG0*(1.0-DBIM*DELTIM)*(1.0-DBIM*DELTIM)
! if ( ABS(DBIM * U1(J,K)) .gt. .01 )

if (K < IDXZB(I)) then ! --- lm mb (*j*) changes overwrite GWD
! ---------------------------------------
DBIM = DB(I,K) / (1.+DB(I,K)*DELTIM)
A(J,K) = - DBIM * V1(J,K) + A(J,K)
B(J,K) = - DBIM * U1(J,K) + B(J,K)
ENG1 = ENG0*(1.0-DBIM*DELTIM)*(1.0-DBIM*DELTIM)

! if ( ABS(DBIM * U1(J,K)) > .01 )
! & print *,' in gwdps_lmi.f KDT=',KDT,I,K,DB(I,K),
! & dbim,idxzb(I),U1(J,K),V1(J,K),me
DUSFC(J) = DUSFC(J) - DBIM * U1(J,K) * DEL(J,K)
DVSFC(J) = DVSFC(J) - DBIM * V1(J,K) * DEL(J,K)
else
!
A(J,K) = DTAUY + A(J,K)
B(J,K) = DTAUX + B(J,K)
ENG1 = 0.5*(
& (U1(J,K)+DTAUX*DELTIM)*(U1(J,K)+DTAUX*DELTIM)
& + (V1(J,K)+DTAUY*DELTIM)*(V1(J,K)+DTAUY*DELTIM))
DUSFC(J) = DUSFC(J) + DTAUX * DEL(J,K)
DVSFC(J) = DVSFC(J) + DTAUY * DEL(J,K)

tem1 = DBIM * DEL(J,K)
DUSFC(J) = DUSFC(J) - tem1 * U1(J,K)
DVSFC(J) = DVSFC(J) - tem1 * V1(J,K)
else ! orographic GWD applied
! ----------------------
A(J,K) = DTAUY + A(J,K)
B(J,K) = DTAUX + B(J,K)
tem1 = U1(J,K) + DTAUX*DELTIM
tem2 = V1(J,K) + DTAUY*DELTIM
ENG1 = 0.5 * (tem1*tem1+tem2*tem2)
DUSFC(J) = DUSFC(J) + DTAUX * DEL(J,K)
DVSFC(J) = DVSFC(J) + DTAUY * DEL(J,K)
endif
C(J,K) = C(J,K) + max(ENG0-ENG1,0.)/CP/DELTIM
C(J,K) = C(J,K) + max(ENG0-ENG1,0.) * oneocpdt
ENDDO
ENDDO

! if (lprnt) then
! print *,' in gwdps_lm.f after A=',A(ipr,:)
! print *,' in gwdps_lm.f after B=',B(ipr,:)
! print *,' DB=',DB(ipr,:)
! endif

DO I = 1,npt
J = ipt(i)
! TEM = (-1.E3/G)
J = ipt(i)
! TEM = (-1.E3/G)
DUSFC(J) = - onebg * DUSFC(J)
DVSFC(J) = - onebg * DVSFC(J)
ENDDO
Expand Down Expand Up @@ -1310,4 +1317,4 @@ end subroutine gwdps_run
subroutine gwdps_finalize()
end subroutine gwdps_finalize

end module gwdps
end module gwdps
8 changes: 4 additions & 4 deletions physics/module_sf_ruclsm.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@ MODULE module_sf_ruclsm
!>\section gen_lsmruc GSD RUC LSM General Algorithm
!! @{
SUBROUTINE LSMRUC( &
DT,init,restart,KTAU,iter,NSL, &
DT,init,lsm_cold_start,KTAU,iter,NSL, &
graupelncv,snowncv,rainncv,raincv, &
ZS,RAINBL,SNOW,SNOWH,SNOWC,FRZFRAC,frpcpn, &
rhosnf,precipfr, &
Expand Down Expand Up @@ -97,7 +97,7 @@ SUBROUTINE LSMRUC( &
!-----------------------------------------------------------------
!-- DT time step (second)
! init - flag for initialization
! restart - flag for restart run
!lsm_cold_start - flag for cold start run
! ktau - number of time step
! NSL - number of soil layers
! NZS - number of levels in soil
Expand Down Expand Up @@ -166,7 +166,7 @@ SUBROUTINE LSMRUC( &
! INTEGER, PARAMETER :: nddzs=2*(nzss-2)

REAL, INTENT(IN ) :: DT
LOGICAL, INTENT(IN ) :: myj,frpcpn,init,restart
LOGICAL, INTENT(IN ) :: myj,frpcpn,init,lsm_cold_start
INTEGER, INTENT(IN ) :: NLCAT, NSCAT ! , mosaic_lu, mosaic_soil
INTEGER, INTENT(IN ) :: ktau, iter, nsl, isice, iswater, &
ims,ime, jms,jme, kms,kme, &
Expand Down Expand Up @@ -423,7 +423,7 @@ SUBROUTINE LSMRUC( &
!> - Initialize soil/vegetation parameters
!--- This is temporary until SI is added to mass coordinate ---!!!!!

if(init .and. (.not. restart) .and. iter == 1) then
if(init .and. (lsm_cold_start) .and. iter == 1) then
DO J=jts,jte
DO i=its,ite
! do k=1,nsl
Expand Down
Loading