From eff984d6257f0a99855578a2ff50081e80324188 Mon Sep 17 00:00:00 2001 From: grantfirl Date: Mon, 25 Oct 2021 17:44:06 -0600 Subject: [PATCH 1/3] change flag_for_restart to do_lsm_cold_start in GFS_phys_time_vary and sfc_drv_ruc --- physics/GFS_phys_time_vary.fv3.F90 | 6 +++--- physics/GFS_phys_time_vary.fv3.meta | 6 +++--- physics/GFS_phys_time_vary.scm.F90 | 6 +++--- physics/GFS_phys_time_vary.scm.meta | 6 +++--- physics/module_sf_ruclsm.F90 | 8 ++++---- physics/sfc_drv_ruc.F90 | 32 ++++++++++++++--------------- physics/sfc_drv_ruc.meta | 12 +++++------ 7 files changed, 38 insertions(+), 38 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index a8ecc1a5e..641e3b897 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -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) :: xlat_d(:), xlon_d(:) @@ -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(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' do ix=1,im diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 979200a85..8254923c8 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -978,9 +978,9 @@ kind = kind_phys intent = in optional = F -[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 diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index b06e46cdc..26766d397 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -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) :: xlat_d(:), xlon_d(:) @@ -349,7 +349,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(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' do ix=1,im diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index a075e8d82..622df26fd 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -978,9 +978,9 @@ kind = kind_phys intent = in optional = F -[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 diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 1e0ec2fe2..e9fd87595 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -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, & @@ -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 @@ -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, & @@ -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 diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index e426424a8..4133f1051 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -31,7 +31,7 @@ module lsm_ruc !! \htmlinclude lsm_ruc_init.html !! subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & - flag_restart, flag_init, con_fvirt, con_rd, & + lsm_cold_start, flag_init, con_fvirt, con_rd, & im, lsoil_ruc, lsoil, kice, nlev, & ! in lsm_ruc, lsm, slmsk, stype, vtype, & ! in q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in @@ -49,7 +49,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & implicit none ! --- in integer, intent(in) :: me, master, isot, ivegsrc, nlunit - logical, intent(in) :: flag_restart + logical, intent(in) :: lsm_cold_start logical, intent(in) :: flag_init integer, intent(in) :: im integer, intent(in) :: lsoil_ruc @@ -154,7 +154,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & write (0,*) 'tg3=',tg3(ipr) write (0,*) 'slmsk=',slmsk(ipr) write (0,*) 'flag_init =',flag_init - write (0,*) 'flag_restart =',flag_restart + write (0,*) 'lsm_cold_start =',lsm_cold_start endif !--- initialize soil vegetation @@ -168,7 +168,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !-- initialize background emissivity semisbase(i) = lemitbl(vtype(i)) ! no snow effect - if (.not.flag_restart) then + if (lsm_cold_start) then !-- land semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + 0.99 * sncovr_lnd(i) @@ -195,13 +195,13 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & sfcqv_lnd(i) = q0 qs1 = rslf(prsl1(i),tsfc_ice(i)) sfcqv_ice(i) = qs1 - endif ! .not. restart + endif ! lsm_cold_start enddo ! i call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in + call rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in stype, vtype, & ! in tsfc_lnd, tsfc_wat, tg3, & ! in @@ -356,7 +356,7 @@ subroutine lsm_ruc_run & ! inputs & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & ! - & flag_iter, flag_guess, flag_init, flag_restart, & + & flag_iter, flag_guess, flag_init, lsm_cold_start, & & flag_cice, frac_grid, errmsg, errflg & & ) @@ -438,7 +438,7 @@ subroutine lsm_ruc_run & ! inputs & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice - logical, intent(in) :: flag_init, flag_restart + logical, intent(in) :: flag_init, lsm_cold_start character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -574,7 +574,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'vtype=',ipr,vtype(ipr) write (0,*)'kdt, iter =',kdt,iter write (0,*)'flag_init =',flag_init - write (0,*)'flag_restart =',flag_restart + write (0,*)'lsm_cold_start =',lsm_cold_start endif ims = 1 @@ -1037,7 +1037,7 @@ subroutine lsm_ruc_run & ! inputs !> - Call RUC LSM lsmruc() for land. call lsmruc( & - & delt, flag_init, flag_restart, kdt, iter, nsoil, & + & delt, flag_init, lsm_cold_start, kdt, iter, nsoil, & & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), & & zs, prcp(i,j), sneqv_lnd(i,j), snowh_lnd(i,j), & & sncovr_lnd(i,j), & @@ -1278,7 +1278,7 @@ subroutine lsm_ruc_run & ! inputs !> - Call RUC LSM lsmruc() for ice. call lsmruc( & - & delt, flag_init, flag_restart, kdt, iter, nsoil, & + & delt, flag_init, lsm_cold_start, kdt, iter, nsoil, & & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), & & zs, prcp(i,j), sneqv_ice(i,j), snowh_ice(i,j), & & sncovr_ice(i,j), & @@ -1461,8 +1461,8 @@ end subroutine lsm_ruc_run !>\ingroup lsm_ruc_group !! This subroutine contains RUC LSM initialization. - subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in - me, master, lsm_ruc, lsm, slmsk, & ! in + subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in + nlev, me, master, lsm_ruc, lsm, slmsk, & ! in stype, vtype, & ! in tskin_lnd, tskin_wat, tg3, & ! !in zs, dzs, smc, slc, stc, & ! in @@ -1471,7 +1471,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in implicit none - logical, intent(in ) :: restart + logical, intent(in ) :: lsm_cold_start integer, intent(in ) :: lsm integer, intent(in ) :: lsm_ruc integer, intent(in ) :: im, nlev @@ -1551,7 +1551,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in else if (debug_print) then write (0,*) 'Start of RUC LSM initialization' write (0,*)'lsoil, lsoil_ruc =',lsoil, lsoil_ruc - write (0,*)'restart = ',restart + write (0,*)'lsm_cold_start = ',lsm_cold_start endif ipr = 10 @@ -1579,7 +1579,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in !! Check if RUC soil data (tslb, ...) is provided or not !if (minval(tslb)==maxval(tslb)) then ! For restart runs, can assume that RUC soil data is provided - if (.not.restart) then + if (lsm_cold_start) then flag_sst = 0 diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index c793b5b9a..7fb6924bb 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -47,9 +47,9 @@ type = integer intent = in optional = F -[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 @@ -1763,9 +1763,9 @@ type = logical intent = in optional = F -[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 From 6dcc5e0119e3d2351a8f8abc0ae53448bd79a1db Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 2 Feb 2022 18:55:56 +0000 Subject: [PATCH 2/3] updated gwdphys.f --- physics/gwdps.f | 111 +++++++++++++++++++++++++----------------------- 1 file changed, 59 insertions(+), 52 deletions(-) diff --git a/physics/gwdps.f b/physics/gwdps.f index 285bdf67c..12b2fefa0 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -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 @@ -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 & @@ -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 @@ -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 @@ -428,12 +429,13 @@ 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 @@ -441,17 +443,17 @@ subroutine gwdps_run( & 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! @@ -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 @@ -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 @@ -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) @@ -770,7 +772,6 @@ subroutine gwdps_run( & ! do i=1,npt IDXZB(i) = 0 - RDXZB(i) = 0. enddo ENDIF ! @@ -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 @@ -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 @@ -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) @@ -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 @@ -1218,6 +1219,7 @@ 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) @@ -1225,30 +1227,35 @@ subroutine gwdps_run( & 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,:) @@ -1256,8 +1263,8 @@ subroutine gwdps_run( & ! 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 @@ -1310,4 +1317,4 @@ end subroutine gwdps_run subroutine gwdps_finalize() end subroutine gwdps_finalize - end module gwdps \ No newline at end of file + end module gwdps From e87f7a5378720f77c224cd6798a069bf5d392c18 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 2 Feb 2022 14:36:55 -0700 Subject: [PATCH 3/3] bugfixes to pass ccpp_prebuild.py after merge with main --- physics/GFS_phys_time_vary.fv3.meta | 1 - physics/GFS_phys_time_vary.scm.meta | 1 - physics/sfc_drv_ruc.F90 | 4 ++-- physics/sfc_drv_ruc.meta | 2 -- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 4f85a0b0f..b4ede6f5a 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -874,7 +874,6 @@ type = real kind = kind_phys intent = in - optional = F [lsm_cold_start] standard_name = do_lsm_cold_start long_name = flag to signify LSM is cold-started diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index eafeb6dd8..21ebfb8e0 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -874,7 +874,6 @@ type = real kind = kind_phys intent = in - optional = F [lsm_cold_start] standard_name = do_lsm_cold_start long_name = flag to signify LSM is cold-started diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 64c75012a..4c42f17fe 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -1,4 +1,4 @@ -+!>\file sfc_drv_ruc.F90 +!>\file sfc_drv_ruc.F90 !! This file contains the RUC land surface scheme driver. module lsm_ruc @@ -210,7 +210,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) - if (.not.flag_restart) then + if (lsm_cold_start) then do i = 1, im ! i - horizontal loop do k = 1, min(kice,lsoil_ruc) ! - at initial time set sea ice T (tsice) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index df3fe5a9b..b9709c4d3 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -42,7 +42,6 @@ dimensions = () type = integer intent = in - optional = F [lsm_cold_start] standard_name = do_lsm_cold_start long_name = flag to signify LSM is cold-started @@ -1567,7 +1566,6 @@ dimensions = () type = logical intent = in - optional = F [lsm_cold_start] standard_name = do_lsm_cold_start long_name = flag to signify LSM is cold-started