From 14d0aadc114e7f10275480a157dd5891074011b4 Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Tue, 12 Mar 2024 12:18:03 -0400 Subject: [PATCH 01/12] remove veg-dependent opt_diag used in hr3 --- physics/SFC_Layer/UFS/sfc_diag_post.F90 | 14 +------------- physics/SFC_Layer/UFS/sfc_diag_post.meta | 7 ------- 2 files changed, 1 insertion(+), 20 deletions(-) diff --git a/physics/SFC_Layer/UFS/sfc_diag_post.F90 b/physics/SFC_Layer/UFS/sfc_diag_post.F90 index 6945e48e9..de5e38aa4 100644 --- a/physics/SFC_Layer/UFS/sfc_diag_post.F90 +++ b/physics/SFC_Layer/UFS/sfc_diag_post.F90 @@ -14,7 +14,7 @@ module sfc_diag_post !! #endif subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, con_eps, con_epsm1, pgr,& - vegtype,t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & + t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & wind10mmax, u10mmax, v10mmax, dpt2m, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec @@ -22,7 +22,6 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co implicit none integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag - integer, dimension(:), intent(in) :: vegtype ! vegetation type (integer index) logical, intent(in) :: lssav real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 logical , dimension(:), intent(in) :: dry @@ -42,17 +41,6 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co errflg = 0 if (lsm == lsm_noahmp) then -! over shrublands use opt_diag=2 - do i=1, im - if(dry(i)) then - if (vegtype(i) == 6 .or. vegtype(i) == 7 & - .or. vegtype(i) == 16) then - t2m(i) = t2mmp(i) - q2m(i) = q2mp(i) - endif - endif - enddo - if (opt_diag == 2 .or. opt_diag == 3) then do i=1,im if(dry(i)) then diff --git a/physics/SFC_Layer/UFS/sfc_diag_post.meta b/physics/SFC_Layer/UFS/sfc_diag_post.meta index 4abb3bac0..8c74e2154 100644 --- a/physics/SFC_Layer/UFS/sfc_diag_post.meta +++ b/physics/SFC_Layer/UFS/sfc_diag_post.meta @@ -82,13 +82,6 @@ type = real kind = kind_phys intent = in -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent= in [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp From 0ff86ac719fe84eeb796094c482abf9061284fa4 Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Thu, 28 Mar 2024 12:56:07 -0400 Subject: [PATCH 02/12] use radiative temp as skin temp to the atmosphere --- physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index c2c03d0de..0f2e4e717 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -658,6 +658,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation real (kind=kind_phys) :: virtfac1 ! virtual factor + real (kind=kind_phys) :: tflux ! surface flux temp real (kind=kind_phys) :: tvs1 ! surface virtual temp real (kind=kind_phys) :: vptemp ! virtual potential temp @@ -934,7 +935,8 @@ subroutine noahmpdrv_run & t2mmp(i) = temperature_bare_2m q2mp(i) = spec_humidity_bare_2m - tskin(i) = temperature_ground + tskin(i) = temperature_radiative + tflux = temperature_ground surface_temperature = temperature_ground vegetation_fraction = vegetation_frac ch_vegetated = 0.0 @@ -1024,7 +1026,8 @@ subroutine noahmpdrv_run & q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & spec_humidity_bare_2m * (1-vegetation_fraction) - tskin(i) = surface_temperature + tskin(i) = temperature_radiative + tflux = surface_temperature endif ! glacial split ends @@ -1170,9 +1173,9 @@ subroutine noahmpdrv_run & endif if(thsfc_loc) then ! Use local potential temperature - tvs1 = tskin(i) * virtfac1 + tvs1 = tflux * virtfac1 else ! Use potential temperature referenced to 1000 hPa - tvs1 = tskin(i)/prsik1(i) * virtfac1 + tvs1 = tflux/prsik1(i) * virtfac1 endif z0_total = max(min(z0_total,forcing_height),1.0e-6) From 9e5eeb83f70a2d6730684617306dc58c88fb2162 Mon Sep 17 00:00:00 2001 From: helin wei Date: Thu, 4 Apr 2024 15:09:44 +0000 Subject: [PATCH 03/12] create a single_loop_alternate for hr4_test3 --- .../Land/Noahmp/module_sf_noahmplsm.F90 | 33 +++++++++---------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index 6abd59f69..d97a81ba2 100644 --- 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) From e039a94ae1a718fe7e7c517c1f61c6d4fc100c8d Mon Sep 17 00:00:00 2001 From: helin wei Date: Mon, 8 Apr 2024 23:13:53 +0000 Subject: [PATCH 04/12] opt_trs bug fixed --- physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index d97a81ba2..e519e472c 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -5873,7 +5873,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out - elseif (opt_trs == chen09 .or. opt_trs == tessel) then + elseif (opt_trs == tessel) then if (vegtyp <= 5) then z0h_out = z0m_out @@ -5881,7 +5881,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out * 0.01 endif - elseif (opt_trs == blumel99) then + elseif (opt_trs == chen09 .or. opt_trs == blumel99) then reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c if (reyn > 2.0) then From 31bca4e8fc5c41c01597a6d91d3718d72b581116 Mon Sep 17 00:00:00 2001 From: "helin.wei" Date: Wed, 22 May 2024 17:45:46 +0000 Subject: [PATCH 05/12] test 6-9 --- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 | 18 +++++++++++++++++- .../Land/Noahmp/module_sf_noahmplsm.F90 | 11 ++++++----- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index f53ab3928..6c810c622 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -593,8 +593,24 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 +! using stc and tgxy to linearly interpolate the snow temp for each layer +!Calculate the total thickness +! total_thickness = sum(dzsno) +! Calculate the temperature difference +! temp_diff=tgxy(ix)-stc(ix,1) +! Calculate the mid-points and interpolate temperatures for each layer +! accumulated_thickness = 0.0 +! do is = isnow, 0 +! accumulated_thickness = accumulated_thickness + dzsno(is) +! mid_points(is) = accumulated_thickness - dzsno(is) / 2.0 +! layer_temp = tgxy(ix) + (mid_points(is) / total_thickness) * temp_diff +! tsnoxy(ix,is) = layer_temp +! end do + do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) +! tsnoxy(ix,is) = tgxy(ix) +! tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(tgxy(ix)-stc(ix,1)) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index e519e472c..3451f807e 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -1989,7 +1989,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys), parameter :: mpe = 1.e-6 real (kind=kind_phys), parameter :: psiwlt = -150. !metric potential for wilting point (m) - real (kind=kind_phys), parameter :: z0 = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + real (kind=kind_phys), parameter :: z0 = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -2626,10 +2626,10 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso ! thermal conductivity of snow do iz = isnow+1, 0 -! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) + tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) ! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 ! tksno(iz) = 0.35 ! constant - tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) ! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) enddo @@ -5817,7 +5817,8 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, if (opt_trs == z0heqz0m) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg z0h_out = z0m_out elseif (opt_trs == chen09) then @@ -5834,7 +5835,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, endif z0h_out = exp( fveg * log(z0m * exp(-czil*0.4*258.2*sqrt(ustarx*z0m))) + & - (1.0 - fveg) * log(max(z0m/exp(kb_sigma_f0),1.0e-6)) ) + (1.0 - fveg) * log(max(z0mg/exp(kb_sigma_f0),1.0e-6)) ) elseif (opt_trs == tessel) then From 1816f724b64aae130beb531e9d2106ad11c3c863 Mon Sep 17 00:00:00 2001 From: helin wei Date: Thu, 20 Jun 2024 00:56:06 +0000 Subject: [PATCH 06/12] all changes from test6 to test11 --- physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index 3451f807e..67426a319 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -2626,9 +2626,9 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso ! thermal conductivity of snow do iz = isnow+1, 0 - tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) +! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) ! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 -! tksno(iz) = 0.35 ! constant + tksno(iz) = 0.35 ! constant ! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) ! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) enddo From 04074884c04139ecc86d02f0123a0aa2f5a8ccb1 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Thu, 20 Jun 2024 19:52:56 +0000 Subject: [PATCH 07/12] Output updraft value of convective cloud condensate --- physics/CONV/SAMF/samfdeepcnv.f | 5 ++++- physics/CONV/SAMF/samfshalcnv.f | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index 7c2d9acf8..90ff4dfd4 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -3430,7 +3430,10 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do i = 1, im if (cnvflg(i) .and. rn(i) > 0.) then if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + tem=max(sigmaout(i,k),0.) + tem1=min(tem,1.0) + cnvw(i,k)=cnvw(i,k)*tem1 endif endif enddo diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index f720c4701..41f0124c6 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -2405,7 +2405,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if (cnvflg(i)) then if (k >= kbcon(i) .and. k < ktcon(i)) then cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 - endif + tem=max(sigmaout(i,k),0.) + tem1=min(tem,1.0) + cnvw(i,k)=cnvw(i,k)*tem1 + endif endif enddo enddo From b73269fcd3660b5c69cc110f796ef4a4b4e227be Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Tue, 25 Jun 2024 18:08:51 +0000 Subject: [PATCH 08/12] update xkinv1 to 0.15 --- physics/PBL/SATMEDMF/satmedmfvdifq.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 95a1e35e5..c0e43e809 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -275,7 +275,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=1000.) parameter(qlcr=3.5e-5,zstblmax=2500.) - parameter(xkinv1=0.4,xkinv2=0.3) + parameter(xkinv1=0.15,xkinv2=0.3) parameter(h1=0.33333333,hcrinv=250.) parameter(vegflo=0.1,vegfup=1.0,z0lo=0.1,z0up=1.0) parameter(vc0=1.0,zc0=1.0) From 891959c2680b91ba745e4edbd7a7c98e17101d12 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Tue, 25 Jun 2024 21:03:28 +0000 Subject: [PATCH 09/12] add check if progsigma is true --- physics/CONV/SAMF/samfdeepcnv.f | 10 +++++++--- physics/CONV/SAMF/samfshalcnv.f | 10 +++++++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index 90ff4dfd4..be43795b4 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -3431,9 +3431,13 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if (cnvflg(i) .and. rn(i) > 0.) then if (k >= kbcon(i) .and. k < ktcon(i)) then cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 - tem=max(sigmaout(i,k),0.) - tem1=min(tem,1.0) - cnvw(i,k)=cnvw(i,k)*tem1 + if(progsigma)then + tem=max(sigmaout(i,k),0.) + tem1=min(tem,1.0) + cnvw(i,k)=cnvw(i,k)*tem1 + else + cnvw(i,k)=cnvw(i,k)*sigmagfm(i) + endif endif endif enddo diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index 41f0124c6..fa9d77a53 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -2405,9 +2405,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if (cnvflg(i)) then if (k >= kbcon(i) .and. k < ktcon(i)) then cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 - tem=max(sigmaout(i,k),0.) - tem1=min(tem,1.0) - cnvw(i,k)=cnvw(i,k)*tem1 + if(progsigma)then + tem=max(sigmaout(i,k),0.) + tem1=min(tem,1.0) + cnvw(i,k)=cnvw(i,k)*tem1 + else + cnvw(i,k)=cnvw(i,k)*sigmagfm(i) + endif endif endif enddo From 3a361b2440e73f8c734d05a2ddcae2d69d7abc85 Mon Sep 17 00:00:00 2001 From: helin wei Date: Tue, 2 Jul 2024 16:32:04 +0000 Subject: [PATCH 10/12] update noahmp table for hr4 --- .../SFC_Models/Land/Noahmp/noahmptable.tbl | 32 ++++++++++--------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/physics/SFC_Models/Land/Noahmp/noahmptable.tbl b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl index 3ffd5b532..44531919e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmptable.tbl +++ b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl @@ -217,7 +217,7 @@ !--------------------------------------------------------------------------------------------------------------------------------------------------------------------- ch2op = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, dleaf = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, - z0mvt = 1.09, 1.10, 0.85, 0.80, 0.80, 0.20, 0.06, 0.60, 0.50, 0.12, 0.30, 0.15, 1.00, 0.14, 0.00, 0.00, 0.00, 0.30, 0.20, 0.03, + z0mvt = 1.00, 1.50, 0.75, 0.90, 0.85, 0.20, 0.10, 0.90, 0.60, 0.20, 0.30, 0.25, 1.00, 0.25, 0.00, 0.015, 0.00, 0.30, 0.10, 0.05, hvt = 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, 2.00, 0.50, hvb = 8.50, 8.00, 7.00, 11.5, 10.0, 0.10, 0.10, 0.10, 0.10, 0.05, 0.10, 0.10, 1.00, 0.10, 0.00, 0.00, 0.00, 0.30, 0.20, 0.10, z0mhvt= 0.0545, 0.055, 0.047, 0.050, 0.050, 0.182, 0.0545, 0.046, 0.050, 0.120, 0.060, 0.075, 0.067, 0.093, 0.000, 0.000, 0.000, 0.075, 0.100, 0.060, @@ -226,32 +226,34 @@ !mfsno = 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, ! c. he 12/17/2020: optimized mfsno values dependent on land type based on evaluation with snotel swe and modis scf, surface albedo mfsno = 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, 3.50, 3.50, +!mfsno = 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, ! c. he 12/17/2020: optimized snow cover factor (m) in scf formulation to replace original constant 2.5*z0,z0=0.002m, based on evaluation with snotel swe and modis scf, surface albedo ! scffac = 0.008, 0.008, 0.008, 0.008, 0.008, 0.016, 0.016, 0.020, 0.020, 0.020, 0.020, 0.014, 0.042, 0.026, 0.030, 0.016, 0.030, 0.030, 0.030, 0.030, - scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, + scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, +! scffac = 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, cbiom = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, ! row 1: vis ! row 2: near ir rhol_vis=0.07, 0.10, 0.07, 0.10, 0.10, 0.07, 0.07, 0.07, 0.10, 0.11, 0.105, 0.11, 0.00, 0.11, 0.00, 0.00, 0.00, 0.10, 0.10, 0.10, - rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.58, 0.515, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, + rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.35, 0.515, 0.35, 0.00, 0.35, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, ! row 1: vis ! row 2: near ir - rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.36, 0.26, 0.36, 0.00, 0.36, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, - rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.58, 0.485, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, + rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.31, 0.26, 0.31, 0.00, 0.31, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, + rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.53, 0.485, 0.53, 0.00, 0.53, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, ! row 1: vis ! row 2: near ir - taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.07, 0.06, 0.07, 0.00, 0.07, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, - taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.25, 0.25, 0.25, 0.00, 0.25, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, + taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.06, 0.05, 0.00, 0.05, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, + taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.34, 0.25, 0.34, 0.00, 0.34, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, ! row 1: vis ! row 2: near ir - taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.220, 0.1105, 0.220, 0.000, 0.220, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.380, 0.1905, 0.380, 0.000, 0.380, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.120, 0.1105, 0.120, 0.000, 0.120, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.250, 0.1905, 0.250, 0.000, 0.250, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - xl = 0.010, 0.010, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, + xl = 0.010, 0.10, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, ! make cwpvt vegetation dependent according to j. goudriaan, crop micrometeorology: a simulation study (simulation monographs), 1977). c. he, 12/17/2020 ! cwpvt = 0.18, 0.67, 0.18, 0.67, 0.29, 1.0, 2.0, 1.3, 1.0, 5.0, 1.17, 1.67, 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, 1.0, 0.18, cwpvt = 0.09, 0.335, 0.09, 0.335, 0.145, 0.5, 1.0, 0.65, 0.5, 2.5, 0.585, 0.835, 0.835, 0.835, 0.09, 0.09, 0.09, 0.335, 0.5, 0.09, @@ -335,10 +337,10 @@ !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 soil color index for soil albedo !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - albsat_vis = 0.25, 0.23, 0.21, 0.20, 0.19, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.04 ! saturated soil albedos - albsat_nir = 0.50, 0.46, 0.42, 0.40, 0.38, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! saturated soil albedos - albdry_vis = 0.36, 0.34, 0.32, 0.31, 0.30, 0.29, 0.28, 0.27, 0.26, 0.25, 0.24, 0.23, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! dry soil albedos - albdry_nir = 0.61, 0.57, 0.53, 0.51, 0.49, 0.48, 0.45, 0.43, 0.41, 0.39, 0.37, 0.35, 0.33, 0.31, 0.29, 0.27, 0.25, 0.23, 0.21, 0.16 ! dry soil albedos + albsat_vis = 0.21, 0.20, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.13, 0.12, 0.11, 0.10, 0.10, 0.09, 0.08, 0.08, 0.08, 0.07, 0.07, 0.06 ! saturated soil albedos + albsat_nir = 0.42, 0.40, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.26, 0.24, 0.22, 0.20, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! saturated soil albedos + albdry_vis = 0.31, 0.30, 0.28, 0.27, 0.26, 0.24, 0.23, 0.22, 0.22, 0.22, 0.20, 0.19, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! dry soil albedos + albdry_nir = 0.52, 0.50, 0.46, 0.44, 0.42, 0.40, 0.38, 0.37, 0.36, 0.34, 0.32, 0.30, 0.30, 0.28, 0.27, 0.27, 0.27, 0.26, 0.25, 0.25 ! dry soil albedos albice = 0.80, 0.55 ! albedo land ice: 1=vis, 2=nir alblak = 0.60, 0.40 ! albedo frozen lakes: 1=vis, 2=nir omegas = 0.8 , 0.4 ! two-stream parameter omega for snow @@ -397,7 +399,7 @@ class_sno_age = 3600.0 ! snow aging e-folding time (s) in class albedo scheme class_alb_new = 0.84 ! fresh snow albedo in class scheme psiwlt = -150.0 !metric potential for wilting point (m) - z0soil = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + z0soil = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) z0lake = 0.01 ! lake surface roughness length (m) / From 1e9b0dd6c9c9da577349e02c1bb6fc912d29ceba Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Tue, 16 Jul 2024 16:20:14 +0000 Subject: [PATCH 11/12] address seg fault if progsigma=F --- physics/CONV/SAMF/samfdeepcnv.f | 33 +++++++++++++++----------- physics/CONV/SAMF/samfshalcnv.f | 42 +++++++++++++++++---------------- 2 files changed, 41 insertions(+), 34 deletions(-) diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index be43795b4..3ad067657 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -215,7 +215,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), - & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km) + & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km), + & sigmaoutx(im) real(kind=kind_phys) gravinv,invdelt,sigmind,sigminm,sigmins parameter(sigmind=0.01,sigmins=0.03,sigminm=0.01) logical flag_shallow, flag_mid @@ -3423,24 +3424,28 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & endif enddo c -c convective cloud water +! + if(progsigma)then + do i = 1, im + sigmaoutx(i)=max(sigmaout(i,1),0.0) + sigmaoutx(i)=min(sigmaoutx(i),1.0) + enddo + endif c !> - Calculate convective cloud water. do k = 1, km - do i = 1, im - if (cnvflg(i) .and. rn(i) > 0.) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 - if(progsigma)then - tem=max(sigmaout(i,k),0.) - tem1=min(tem,1.0) - cnvw(i,k)=cnvw(i,k)*tem1 - else - cnvw(i,k)=cnvw(i,k)*sigmagfm(i) + do i = 1, im + if (cnvflg(i) .and. rn(i) > 0.) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if(progsigma)then + cnvw(i,k) = cnvw(i,k) * sigmaoutx(i) + else + cnvw(i,k) = cnvw(i,k) * sigmagfm(i) + endif endif endif - endif - enddo + enddo enddo c c convective cloud cover diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index fa9d77a53..ce783ea15 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -162,7 +162,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km), - & sigmab(im),qadv(im,km) + & sigmab(im),qadv(im,km),sigmaoutx(im) real(kind=kind_phys) gravinv,dxcrtas,invdelt,sigmind,sigmins, & sigminm logical flag_shallow,flag_mid @@ -2397,27 +2397,29 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo c -c convective cloud water -c -!> - Calculate shallow convective cloud water. + if(progsigma)then + do i = 1, im + sigmaoutx(i)=max(sigmaout(i,1),0.0) + sigmaoutx(i)=min(sigmaoutx(i),1.0) + enddo + endif + +c convective cloud water do k = 1, km - do i = 1, im - if (cnvflg(i)) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 - if(progsigma)then - tem=max(sigmaout(i,k),0.) - tem1=min(tem,1.0) - cnvw(i,k)=cnvw(i,k)*tem1 - else - cnvw(i,k)=cnvw(i,k)*sigmagfm(i) - endif - endif - endif - enddo + do i = 1, im + if (cnvflg(i)) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if (progsigma) then + cnvw(i,k) = cnvw(i,k) * sigmaoutx(i) + else + cnvw(i,k) = cnvw(i,k) * sigmagfm(i) + endif + endif + endif + enddo enddo - -c +c c convective cloud cover c !> - Calculate convective cloud cover, which is used when pdf-based cloud fraction is used (i.e., pdfcld=.true.). From 35b15e3c499d6fa3ca742fa3f662286b2dd94990 Mon Sep 17 00:00:00 2001 From: helin wei Date: Tue, 16 Jul 2024 17:31:40 +0000 Subject: [PATCH 12/12] remove unnecessary comments for the snow temperature initialization --- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index c5e9c8dd9..08d1d0b49 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -594,22 +594,8 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 ! using stc and tgxy to linearly interpolate the snow temp for each layer -!Calculate the total thickness -! total_thickness = sum(dzsno) -! Calculate the temperature difference -! temp_diff=tgxy(ix)-stc(ix,1) -! Calculate the mid-points and interpolate temperatures for each layer -! accumulated_thickness = 0.0 -! do is = isnow, 0 -! accumulated_thickness = accumulated_thickness + dzsno(is) -! mid_points(is) = accumulated_thickness - dzsno(is) / 2.0 -! layer_temp = tgxy(ix) + (mid_points(is) / total_thickness) * temp_diff -! tsnoxy(ix,is) = layer_temp -! end do do is = isnow,0 -! tsnoxy(ix,is) = tgxy(ix) -! tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(tgxy(ix)-stc(ix,1)) tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd