Skip to content

Commit f68ffdb

Browse files
hertnekygrantfirlVanderleiVargas-NOAAQingfu-LiuClaraDraper-NOAA
authored
Ufs dev pr367 (NCAR#1223)
* update standard names to move Xgrs to physics_timestep_initial* and remove *_of_new_state (default name refers to 'current' value) * fix a few unchanged standard names * change some timestep_initial variables to general variables; make satmedmfvdifq return new tendencies and new tendency application block in GFS_PBL_generic_post * Refactor physics tendency calculations - Added tendency variables (`ten_t`, `ten_u`, `ten_v`) for temperature and wind tendencies in SAMF deep and shallow convection schemes. - Updated relevant `.meta` files to reflect changes in variable intent (`inout` -> `in` where appropriate) and added tendencies. - Modified Interstitials (`GFS_DCNV_generic_post`, `GFS_DCNV_generic_pre`, `GFS_SCNV_generic_post`, `GFS_SCNV_generic_pre`) to directly use tendencies instead of saved state variables. - Removed redundant saved variables (`save_u`, `save_v`, `save_t`). - Added `delt` to post interstitials. * update unified_ugwp, ugwpv1, and drag_suite to use new tendency code * save tendency work with GFS_photochemistry * add tracer tendency changes to convection; fix typos in GFS_photochemistry * fix typo in samfdeepcnv.f * save tendency work with Thompson MP * save tendency work with radiation * add FMS to ccpp-physics CMakeLists.txt for fv3 * add initial setting of state in GFS_time_vary_pre.fv3; fix horizontal_dimension in GFS_time_vary_pre.scm * fix metadata in GFS_time_vary_pre.fv3 * add momentum tendency output to mp_thompson and fix intent in metadata * fix array size bug in mp_thompson.F90; cleanup dtend code using new tendency paradigm; cleanup saving of states no longer needed * fix improperly-merged conflict resolution in GFS_photochemistry.F90 * fix access of ntlnc/ntinc access of tracer array when missing * convert many RAD, PBL, GWD, CONV, and MP schemes to return tendencies * convert MG micro and Arakawa-Wu adjustment schemes * convert MYNNEDMF PBL scheme to return tendencies * add changes to MYNN EDMF PBL * add back divide-by-zero bugfix in module_sf_noahmp_glacier.F90 that was removed recently * remove obsolete interstitial schemes * fix 2 minor compilation issues after testing with UFS RTs * fix bug in MG MP * fix near-surface air temperature standard name in GFS_surface_composites_pre * apply tendency cleanup to GFDLMPv3 and TEMPO * fix compilation error * fix typo in TEMPO * debug sgscloud_radpre/post * remove tendency application code from rrtmg_lw/sw_post * change thmpsn to thompson to fix compilation error * fix compilation errors in GFS_radiation_post.F90 * remove Zhao-Carr cloud schemes and combine Xu-Randall cloud fraction calculations * fix array size problem in cs_conv.F90 * refactor RAS tendencies * fix compilation error in rascnv.F90 * change Xu-Randall cloud fraction scheme to be elemental * Fixed too-high lower bound for SMC Deleted code associated with already removed print statements Deleted excess comments. * use new cld_frac_XuRandall function from module_radiation_clouds in RRTMGP scheme * Tidy-up for PR. * modify the cld_frac_XuRandall function call in RRTMGP scheme * Changes to the post L-IAU checks: * Change tfreeze to match that in NoahMP * Only set SLC to SMC if temp newly > tfreez * add the repository update to this PR * Revert "add the repository update to this PR" This reverts commit 565d62c. * fix bug in GFDLMPv3 tendency implementation * remove the printing tests * remove Zhao-Carr schemes from modules in the UFS_SCM_NEPTUNE directory * remove Zhao-Carr microphysics scheme from physics/MP directory * fix hail tendency changes from reviewer suggestions * fix indexing bug in cu_tiedtke caught in code review * changes to RAS tendency application update code from code review * check for flag_for_generic_tendency_due_to_gravity_wave_drag before computing diagnostic tendencies in drag_suite * fix diagnostic tendency bug in physics/GWD/ugwpv1_gsldrag.F90 * remove unused arguments in physics/GWD/ugwpv1_gsldrag_post.F90 * fix tendency diagnostics in physics/GWD/unified_ugwp.F90 * fix merge problem in mp_thompson.meta * add arguments to drag_suite_run called outside of ccpp entry point * initialize dclw variables in cu_ntiedtke * fix loop bounds for ten_q in cu_gf_driver.F90 * fix loop bounds in cu_c3_driver * fix new_q typo in mp_fer_hires.F90 * deallocate locally-allocated variables in MP schemes * update zeroing logic in m_micro_post after review * Update for 10m wind option in fire_behavior module * remove non-ASCII character in canopy_levs.F90 (from previous PR) * Updates to progomega option of saSAS convection scheme * Correction * correction 2 * fix line in SHOC where a tracer was being updated directly * remove old_ozone array since it was not being used * deallocate local variables in satmedmfvdifq at end of run phase * save temperature before modification to pass in to diagnostics in GFS_radiation_post * Remove goto in physics/MP/Morrison_Gettelman/aer_cloud.F * Remove goto in physics/Radiation/radiation_clouds.f * fix diagnostic temp tendency in GFS_MP_generic.F90 for when radar is/isn't available * Correct parameter setting in samfshalcnv to pass debug runs * Name END DO * Remove goto physics/MP/calpreciptype.f90 * Remove goto physics/MP/Morrison_Gettelman/cldwat2m_micro.F * Start goto physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 * Remove goto physics/SFC_Layer/UFS/module_nst_model.f90 * address saturation vapor pressure out of bounds error in hafs_4_nest RT * update long names to remove 'updated by physics'; change prognostic updraft standard names * remove additional references to Zhao-Carr microphysics * remove Zhao-Carr references from GFS_scnv_generic_post * fix deallocation statement in Thompson MP * Remove go to physics/CONV/C3/cu_c3_sh.F90 * Remove go to physics/PBL/MYJ/module_BL_MYJPBL.F90 * Remove goto physics/MP/Morrison_Gettelman/wv_saturation.F * Again physics/MP/Morrison_Gettelman/wv_saturation.F * physics/MP/Morrison_Gettelman/wv_saturation.F * Typo * Remove goto physics/CONV/C3/cu_c3_deep.F90 * Remove go to physics/CONV/RAS/rascnv.F90 * Typo rascnv.F90 * physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 * physics/CONV/Grell_Freitas/cu_gf_sh.F90 * Typo module_BL_MYJPBL.F90 * physics/SFC_Layer/MYJ/module_SF_JSFC.F90 * First pass physics/CONV/Grell_Freitas/cu_gf_deep.F90 * physics/CONV/Grell_Freitas/cu_gf_deep.F90 * physics/GWD/ugwp_driver_v0.F * physics/MP/Thompson/module_mp_thompson.F90 * physics/PBL/MYNN_EDMF/module_bl_mynn.F90 * physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 * physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 * Fix compile physics/Radiation/radiation_clouds.f * Compile fixes * Fix for 73 character limit line * Compile fix * Start physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 * physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 * fix additional warnings * Fix compile hafsw wcoss2 * Revert rascnv so control_ras_intel b4b on wcoss2 * remove whitespace changes in radiation_clouds.f --------- Co-authored-by: Grant Firl <grant.firl@noaa.gov> Co-authored-by: VanderleiVargas-NOAA <vanderlei.vargas@noaa.gov> Co-authored-by: Qingfu Liu <Qingfu.Liu@noaa.gov> Co-authored-by: Clara.Draoper-NOAA <clara.draper@noaa.gov> Co-authored-by: Michael Kavulich, Jr <kavulich@ucar.edu> Co-authored-by: Lisa <lisa.bengtsson@noaa.gov> Co-authored-by: Nicholas Szapiro <149816583+NickSzapiro-NOAA@users.noreply.github.com> Co-authored-by: Rhae Sung Kim <rhaesung.kim@noaa.gov> Co-authored-by: Nick Szapiro <nick.szapiro@noaa.gov> Co-authored-by: Nick Szapiro <nick.szapiro@clogin06.cactus.wcoss2.ncep.noaa.gov> Co-authored-by: Grant Firl <grant@Macbook-Air-M4.local>
1 parent 01edf9f commit f68ffdb

20 files changed

Lines changed: 570 additions & 592 deletions

‎physics/CONV/C3/cu_c3_deep.F90‎

Lines changed: 75 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -744,20 +744,18 @@ subroutine cu_c3_deep_run( &
744744
do k=kts,ktf
745745
if(zo_cup(i,k).gt.zkbmax+z1(i))then
746746
kbmax(i)=k
747-
go to 25
747+
exit
748748
endif
749749
enddo
750-
25 continue
751750
!
752751
!> - Compute the level where detrainment for downdraft starts (\p kdet)
753752
!
754753
do k=kts,ktf
755754
if(zo_cup(i,k).gt.z_detr+z1(i))then
756755
kdet(i)=k
757-
go to 26
756+
exit
758757
endif
759758
enddo
760-
26 continue
761759
!
762760
endif
763761
enddo
@@ -770,7 +768,7 @@ subroutine cu_c3_deep_run( &
770768
!
771769
start_k22=2
772770
!$acc parallel loop
773-
do 36 i=its,itf
771+
do i=its,itf
774772
if(ierr(i).eq.0)then
775773
k22(i)=maxloc(heo_cup(i,start_k22:kbmax(i)+2),1)+start_k22-1
776774
if(k22(i).ge.kbmax(i))then
@@ -783,7 +781,7 @@ subroutine cu_c3_deep_run( &
783781
kbcon(i)=0
784782
endif
785783
endif
786-
36 continue
784+
end do
787785
!$acc end parallel
788786

789787
!
@@ -1013,7 +1011,7 @@ subroutine cu_c3_deep_run( &
10131011
!$acc end parallel
10141012

10151013
!$acc kernels
1016-
do 37 i=its,itf
1014+
do i=its,itf
10171015
kzdown(i)=0
10181016
if(ierr(i).eq.0)then
10191017
zktop=(zo_cup(i,ktop(i))-z1(i))*.6
@@ -1024,11 +1022,11 @@ subroutine cu_c3_deep_run( &
10241022
if(zo_cup(i,k).gt.zktop)then
10251023
kzdown(i)=k
10261024
kzdown(i)=min(kzdown(i),kstabi(i)-1) !
1027-
go to 37
1025+
exit
10281026
endif
10291027
enddo
10301028
endif
1031-
37 continue
1029+
end do
10321030
!$acc end kernels
10331031

10341032
!
@@ -2670,8 +2668,8 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, &
26702668
edtc(i,1)=0.
26712669
enddo
26722670
do kk = kts,ktf-1
2673-
do 62 i=its,itf
2674-
if(ierr(i).ne.0)go to 62
2671+
do i=its,itf
2672+
if(ierr(i).ne.0) cycle
26752673
if (kk .le. min0(ktop(i),ktf) .and. kk .ge. kbcon(i)) then
26762674
vws(i) = vws(i)+ &
26772675
(abs((us(i,kk+1)-us(i,kk))/(z(i,kk+1)-z(i,kk))) &
@@ -2680,7 +2678,7 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, &
26802678
sdp(i) = sdp(i) + p(i,kk) - p(i,kk+1)
26812679
endif
26822680
if (kk .eq. ktf-1)vshear(i) = 1.e3 * vws(i) / sdp(i)
2683-
62 continue
2681+
end do
26842682
end do
26852683
do i=its,itf
26862684
if(ierr(i).eq.0)then
@@ -3632,13 +3630,13 @@ subroutine cup_kbcon(ierrc,cap_inc,iloop_in,k22,kbcon,he_cup,hes_cup, &
36323630
!$acc end kernels
36333631

36343632
!$acc parallel loop
3635-
do 27 i=its,itf
3633+
do i=its,itf
36363634
kbcon(i)=1
36373635
!
36383636
! reset iloop for mid level convection
36393637
if(cap_max(i).gt.200 .and. imid.eq.1)iloop(i)=5
36403638
!
3641-
if(ierr(i).ne.0)go to 27
3639+
if(ierr(i).ne.0) cycle
36423640
start_level(i)=k22(i)
36433641
kbcon(i)=k22(i)+1
36443642
if(iloop(i).eq.5)kbcon(i)=k22(i)
@@ -3654,70 +3652,73 @@ subroutine cup_kbcon(ierrc,cap_inc,iloop_in,k22,kbcon,he_cup,hes_cup, &
36543652
enddo
36553653
!==
36563654

3657-
go to 32
3658-
31 continue
3659-
kbcon(i)=kbcon(i)+1
3660-
if(kbcon(i).gt.kbmax(i)+2)then
3661-
if(iloop(i).ne.4)then
3662-
ierr(i)=3
3655+
find_kbcon_loop: do
3656+
3657+
hetest=hcot(i,kbcon(i)) !hkb(i) ! he_cup(i,k22(i))
3658+
if(hetest.lt.hes_cup(i,kbcon(i)))then
3659+
kbcon(i)=kbcon(i)+1
3660+
if(kbcon(i).gt.kbmax(i)+2)then
3661+
if(iloop(i).ne.4)then
3662+
ierr(i)=3
36633663
#ifndef _OPENACC
3664-
ierrc(i)="could not find reasonable kbcon in cup_kbcon"
3664+
ierrc(i)="could not find reasonable kbcon in cup_kbcon"
36653665
#endif
3666-
endif
3667-
go to 27
3668-
endif
3669-
32 continue
3670-
hetest=hcot(i,kbcon(i)) !hkb(i) ! he_cup(i,k22(i))
3671-
if(hetest.lt.hes_cup(i,kbcon(i)))then
3672-
go to 31
3673-
endif
3666+
endif
3667+
exit find_kbcon_loop
3668+
endif
3669+
cycle find_kbcon_loop
3670+
endif
36743671

3675-
! cloud base pressure and max moist static energy pressure
3676-
! i.e., the depth (in mb) of the layer of negative buoyancy
3677-
if(kbcon(i)-k22(i).eq.1)go to 27
3678-
if(iloop(i).eq.5 .and. (kbcon(i)-k22(i)).le.2)go to 27
3679-
pbcdif=-p_cup(i,kbcon(i))+p_cup(i,k22(i))
3680-
plus=max(25.,cap_max(i)-float(iloop(i)-1)*cap_inc(i))
3681-
if(iloop(i).eq.4)plus=cap_max(i)
3672+
! cloud base pressure and max moist static energy pressure
3673+
! i.e., the depth (in mb) of the layer of negative buoyancy
3674+
if(kbcon(i)-k22(i).eq.1) exit find_kbcon_loop
3675+
if(iloop(i).eq.5 .and. (kbcon(i)-k22(i)).le.2) exit find_kbcon_loop
3676+
3677+
pbcdif=-p_cup(i,kbcon(i))+p_cup(i,k22(i))
3678+
plus=max(25.,cap_max(i)-float(iloop(i)-1)*cap_inc(i))
3679+
if(iloop(i).eq.4)plus=cap_max(i)
36823680
!
36833681
! for shallow convection, if cap_max is greater than 25, it is the pressure at pbltop
3684-
if(iloop(i).eq.5)plus=150.
3685-
if(iloop(i).eq.5.and.cap_max(i).gt.200)pbcdif=-p_cup(i,kbcon(i))+cap_max(i)
3686-
if(pbcdif.le.plus)then
3687-
go to 27
3688-
elseif(pbcdif.gt.plus)then
3689-
k22(i)=k22(i)+1
3690-
kbcon(i)=k22(i)+1
3691-
!== since k22 has be changed, hkb has to be re-calculated
3692-
x_add = xlv*zqexec(i)+cp*ztexec(i)
3693-
call get_cloud_bc(kte,he_cup (i,1:kte),hkb (i),k22(i),x_add)
3694-
3695-
start_level(i)=k22(i)
3696-
! if(iloop_in.eq.5)start_level(i)=kbcon(i)
3697-
hcot(i,1:start_level(i)) = hkb(i)
3682+
if(iloop(i).eq.5)plus=150.
3683+
if(iloop(i).eq.5.and.cap_max(i).gt.200)pbcdif=-p_cup(i,kbcon(i))+cap_max(i)
3684+
3685+
if(pbcdif.le.plus)then
3686+
exit find_kbcon_loop
3687+
elseif(pbcdif.gt.plus)then
3688+
k22(i)=k22(i)+1
3689+
kbcon(i)=k22(i)+1
3690+
!== since k22 has be changed, hkb has to be re-calculated
3691+
x_add = xlv*zqexec(i)+cp*ztexec(i)
3692+
call get_cloud_bc(kte,he_cup (i,1:kte),hkb (i),k22(i),x_add)
3693+
3694+
start_level(i)=k22(i)
3695+
! if(iloop_in.eq.5)start_level(i)=kbcon(i)
3696+
hcot(i,1:start_level(i)) = hkb(i)
36983697
!$acc loop seq
3699-
do k=start_level(i)+1,kbmax(i)+3
3700-
dz=z_cup(i,k)-z_cup(i,k-1)
3698+
do k=start_level(i)+1,kbmax(i)+3
3699+
dz=z_cup(i,k)-z_cup(i,k-1)
37013700

3702-
hcot(i,k)= ( (1.-0.5*entr_rate(i)*dz)*hcot(i,k-1) &
3703-
+ entr_rate(i)*dz*heo(i,k-1) )/ &
3704-
(1.+0.5*entr_rate(i)*dz)
3705-
enddo
3706-
!==
3701+
hcot(i,k)= ( (1.-0.5*entr_rate(i)*dz)*hcot(i,k-1) &
3702+
+ entr_rate(i)*dz*heo(i,k-1) )/ &
3703+
(1.+0.5*entr_rate(i)*dz)
3704+
enddo
3705+
!==
37073706

3708-
if(iloop(i).eq.5)kbcon(i)=k22(i)
3709-
if(kbcon(i).gt.kbmax(i)+2)then
3710-
if(iloop(i).ne.4)then
3711-
ierr(i)=3
3707+
if(iloop(i).eq.5)kbcon(i)=k22(i)
3708+
if(kbcon(i).gt.kbmax(i)+2)then
3709+
if(iloop(i).ne.4)then
3710+
ierr(i)=3
37123711
#ifndef _OPENACC
3713-
ierrc(i)="could not find reasonable kbcon in cup_kbcon"
3712+
ierrc(i)="could not find reasonable kbcon in cup_kbcon"
37143713
#endif
3715-
endif
3716-
go to 27
3714+
endif
3715+
exit find_kbcon_loop
3716+
endif
3717+
cycle find_kbcon_loop
37173718
endif
3718-
go to 32
3719-
endif
3720-
27 continue
3719+
end do find_kbcon_loop
3720+
3721+
end do
37213722
!$acc end parallel
37223723

37233724
end subroutine cup_kbcon
@@ -3946,7 +3947,7 @@ subroutine neg_check(name,j,dt,q,outq,outt,outu,outv, &
39463947
,intent (in ) :: &
39473948
dt
39483949
real(kind=kind_phys) :: names,scalef,thresh,qmem,qmemf,qmem2,qtest,qmem1
3949-
integer :: icheck
3950+
integer :: icheck, i, k
39503951
!
39513952
! first do check on vertical heating rate
39523953
!
@@ -4815,17 +4816,18 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo
48154816
enddo
48164817
ktopdby(i)=maxloc(dby(:),1)
48174818
kklev=maxloc(dbm(:),1)
4819+
4820+
kfinalzu=ktf-2
4821+
ktop(i)=kfinalzu
48184822
!$acc loop seq
48194823
do k=maxloc(dby(:),1)+1,ktf-2
48204824
if(dby(k).lt.dbythresh*maxval(dby))then
48214825
kfinalzu=k - 1
48224826
ktop(i)=kfinalzu
4823-
go to 412
4827+
exit
48244828
endif
48254829
enddo
4826-
kfinalzu=ktf-2
4827-
ktop(i)=kfinalzu
4828-
412 continue
4830+
48294831
ktop(i)=ktopdby(i) ! HCB
48304832
kklev=min(kklev+3,ktop(i)-2)
48314833
!
@@ -5774,10 +5776,9 @@ subroutine get_cloud_top(name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo,heso_cup,z_c
57745776
kfinalzu = k - 1
57755777
ktop(i) = kfinalzu
57765778
!print*,'hco4=',k,kfinalzu,ktop(i),kbcon(i)+1;call flush(6)
5777-
go to 412
5779+
exit
57785780
endif
57795781
enddo
5780-
412 continue
57815782
else
57825783
do k=start_level(i)+1,ktf-2
57835784
!~ print*,'hco31=',k,dby(k),dbythresh*maxval(dby)

‎physics/CONV/C3/cu_c3_sh.F90‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -411,13 +411,12 @@ subroutine cu_c3_sh_run ( &
411411
if(ierr(i).eq.0)then
412412
!
413413
!$acc loop seq
414-
do k=kts,ktf
414+
find_kbmax: do k=kts,ktf
415415
if(zo_cup(i,k).gt.zkbmax+z1(i))then
416416
kbmax(i)=k
417-
go to 25
417+
exit find_kbmax
418418
endif
419-
enddo
420-
25 continue
419+
end do find_kbmax
421420
!
422421
kbmax(i)=min(kbmax(i),ktf/2)
423422
endif
@@ -606,7 +605,7 @@ subroutine cu_c3_sh_run ( &
606605
!
607606

608607
!$acc parallel loop private(ki,qaver,k,trash,trash2,dz,dp)
609-
do 42 i=its,itf
608+
do i=its,itf
610609
dbyt(i,:)=0.
611610
if(ierr(i) /= 0) cycle
612611
!$acc loop seq
@@ -648,14 +647,14 @@ subroutine cu_c3_sh_run ( &
648647
#ifndef _OPENACC
649648
ierrc(i)='ktop is less than kbcon+1'
650649
#endif
651-
go to 42
650+
cycle
652651
endif
653652
if(ktop(i).gt.ktf-2)then
654653
ierr(i)=5
655654
#ifndef _OPENACC
656655
ierrc(i)="ktop is larger than ktf-2"
657656
#endif
658-
go to 42
657+
cycle
659658
endif
660659
!
661660
call get_cloud_bc(kte,qo_cup (i,1:kte),qaver,k22(i),zero)
@@ -725,7 +724,7 @@ subroutine cu_c3_sh_run ( &
725724
xzu (i,k)=0.
726725
zuo (i,k)=0.
727726
enddo
728-
42 continue
727+
end do
729728
!$acc end parallel
730729
!
731730
!--- calculate workfunctions for updrafts

0 commit comments

Comments
 (0)