Skip to content

Commit

Permalink
Merge remote-tracking branch 'haiqin/ufs/dev-radar' into c3-pointer-fix
Browse files Browse the repository at this point in the history
  • Loading branch information
@SamuelTrahanNOAA
SamuelTrahanNOAA committed Sep 29, 2023
2 parents e0a949d + ab4d5f1 commit 609c90b
Show file tree
Hide file tree
Showing 11 changed files with 139 additions and 145 deletions.
2 changes: 1 addition & 1 deletion physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -976,7 +976,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
& imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, &
& iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, &
& idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, &
& imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_gf, do_mynnedmf, &
& imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf, &
& lgfdlmprad, &
& uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, &
& effrl, effri, effrr, effrs, effr_in, &
Expand Down
12 changes: 5 additions & 7 deletions physics/cu_c3_deep.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2078,10 +2078,6 @@ subroutine cu_c3_deep_run( &

!> - Call rain_evap_below_cloudbase() to calculate evaporation below cloud base

call rain_evap_below_cloudbase(itf,ktf,its,ite, &
kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, &
po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy)

k=1
!$acc kernels
do i=its,itf
Expand Down Expand Up @@ -2137,7 +2133,7 @@ subroutine cu_c3_deep_run( &
do k = ktop(i), 1, -1
rain = pwo(i,k) + edto(i) * pwdo(i,k)
rn(i) = rn(i) + rain * xmb(i) * .001 * dtime
!if(po(i,k).gt.400.)then
if(k.gt.jmin(i))then
if(flg(i))then
q1=qo(i,k)+(outq(i,k))*dtime
t1=tn(i,k)+(outt(i,k))*dtime
Expand All @@ -2162,7 +2158,7 @@ subroutine cu_c3_deep_run( &
pre(i)=max(pre(i),0.)
delqev(i) = delqev(i) + .001*dp*qevap(i)/g
endif
!endif ! 400mb
endif
endif
enddo
! pre(i)=1000.*rn(i)/dtime
Expand Down Expand Up @@ -4429,7 +4425,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, &
!
!now do the rest
!
kklev(i)=maxloc(zu(i,:),1)
kklev(i)=maxloc(zu(i,2:ktop(i)),1)
!$acc loop seq
do k=kbcon(i)+1,ktop(i)
if(t(i,k) > 273.16) then
Expand Down Expand Up @@ -4489,6 +4485,8 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, &
endif
if(k.gt.kbcon(i)+1)c1d(i,k)=clwdet*up_massdetr(i,k-1)
if(k.gt.kbcon(i)+1)c1d_b(i,k)=clwdet*up_massdetr(i,k-1)
c1d(i,k)=0.005
c1d_b(i,k)=0.005

if(autoconv.eq.2) then
!
Expand Down
45 changes: 4 additions & 41 deletions physics/cu_c3_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -340,8 +340,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!
!> - Set tuning constants for radiation coupling
!
tun_rad_shall(:)=.01
tun_rad_mid(:)=.3 !.02
tun_rad_shall(:)=.012
tun_rad_mid(:)=.15 !.02
tun_rad_deep(:)=.3 !.065
edt(:)=0.
edtm(:)=0.
Expand Down Expand Up @@ -644,7 +644,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
enddo
!$acc end kernels
if (dx(its)<6500.) then
ichoice=10
imid_gf=0
endif
!
Expand Down Expand Up @@ -680,10 +679,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
do i=its,itf
if(xmbs(i).gt.0.)then
cutens(i)=1.
if (dx(i)<6500.) then
ierrm(i)=555
ierr (i)=555
endif
endif
enddo
!$acc end kernels
Expand Down Expand Up @@ -954,38 +949,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp
gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp
gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4)
!
!> - Calculate subsidence effect on clw
!
! dsubclw=0.
! dsubclwm=0.
! dsubclws=0.
! dp=100.*(p2d(i,k)-p2d(i,k+1))
! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then
! clwtot = cliw(i,k) + clcw(i,k)
! clwtot1= cliw(i,k+1) + clcw(i,k+1)
! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 &
! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp
! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 &
! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp
! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp
! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp
! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! endif
! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) &
! +outqcm(i,k)*cutenm(i) &
! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) &
! )
! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf))
! if (clcw(i,k) .gt. -999.0) then
! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice
! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water
! else
! cliw(i,k) = max(0.,cliw(i,k) + tem)
! endif
!
! enddo

!> - FCT treats subsidence effect to cloud ice/water (begin)
dp=100.*(p2d(i,k)-p2d(i,k+1))
Expand Down Expand Up @@ -1041,8 +1004,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
gdc(i,16,10)=pret(i)*3600.

maxupmf(i)=0.
if(forcing(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6))
if(forcing2(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
endif

if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i))
Expand Down
9 changes: 4 additions & 5 deletions physics/cu_c3_driver_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,20 +66,19 @@ subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
conv_act_m(i)=0.0
endif
! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f)
if(sqrt(garea(i)).lt.6500.)then
ze = 0.0
ze_conv = 0.0
dbz_sum = 0.0
cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
ze_conv = 300.0 * cuprate**1.4
if (maxupmf(i).gt.0.05) then
cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
if(cuprate .lt. 0.05) cuprate=0.
ze_conv = 300.0 * cuprate**1.5
if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then
do k = 1, km
ze = 10._kind_phys ** (0.1 * refl_10cm(i,k))
dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv))
refl_10cm(i,k) = dbz_sum
enddo
endif
endif
enddo
!$acc end kernels

Expand Down
10 changes: 6 additions & 4 deletions physics/cu_c3_sh.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,12 @@ module cu_c3_sh
use progsigma, only : progsigma_calc

!real(kind=kind_phys), parameter:: c1_shal=0.0015! .0005
real(kind=kind_phys), parameter:: c1_shal=0. !0.005! .0005
real(kind=kind_phys), parameter:: g =9.81
real(kind=kind_phys), parameter:: cp =1004.
real(kind=kind_phys), parameter:: xlv=2.5e6
real(kind=kind_phys), parameter:: r_v=461.
real(kind=kind_phys), parameter:: c0_shal=.001
real(kind=kind_phys) :: c0_shal=.004
real(kind=kind_phys) :: c1_shal=0. !0.005! .0005
real(kind=kind_phys), parameter:: fluxtune=1.5

contains
Expand Down Expand Up @@ -274,6 +274,8 @@ subroutine cu_c3_sh_run ( &
ktopx(i)=0
if(xland(i).gt.1.5 .or. xland(i).lt.0.5)then
xland1(i)=0
c0_shal=.001
c1_shal=.001
! ierr(i)=100
endif
pre(i)=0.
Expand Down Expand Up @@ -669,11 +671,11 @@ subroutine cu_c3_sh_run ( &
if(qco(i,k)>=trash ) then
dz=z_cup(i,k)-z_cup(i,k-1)
! cloud liquid water
c1d(i,k)=.02*up_massdetr(i,k-1)
c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1)
qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz)
if(qrco(i,k).lt.0.)then ! hli new test 02/12/19
qrco(i,k)=0.
c1d(i,k)=0.
!c1d(i,k)=0.
endif
pwo(i,k)=c0_shal*dz*qrco(i,k)*zuo(i,k)
clw_all(i,k)=qco(i,k)-trash !LB total cloud before rain and detrain
Expand Down
37 changes: 2 additions & 35 deletions physics/cu_gf_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -644,7 +644,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
enddo
!$acc end kernels
if (dx(its)<6500.) then
! ichoice=10
imid_gf=0
endif
!
Expand Down Expand Up @@ -928,38 +927,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
!gdc(i,k,8)=(outq(i,k))*86400.*xlv/cp
gdc(i,k,8)=(outqm(i,k)+outqs(i,k)+outq(i,k))*86400.*xlv/cp
gdc(i,k,9)=gdc(i,k,2)+gdc(i,k,3)+gdc(i,k,4)
!
!> - Calculate subsidence effect on clw
!
! dsubclw=0.
! dsubclwm=0.
! dsubclws=0.
! dp=100.*(p2d(i,k)-p2d(i,k+1))
! if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then
! clwtot = cliw(i,k) + clcw(i,k)
! clwtot1= cliw(i,k+1) + clcw(i,k+1)
! dsubclw=((-edt(i)*zd(i,k+1)+zu(i,k+1))*clwtot1 &
! -(-edt(i)*zd(i,k) +zu(i,k)) *clwtot )*g/dp
! dsubclwm=((-edtm(i)*zdm(i,k+1)+zum(i,k+1))*clwtot1 &
! -(-edtm(i)*zdm(i,k) +zum(i,k)) *clwtot )*g/dp
! dsubclws=(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! dsubclw=dsubclw+(zu(i,k+1)*clwtot1-zu(i,k)*clwtot)*g/dp
! dsubclwm=dsubclwm+(zum(i,k+1)*clwtot1-zum(i,k)*clwtot)*g/dp
! dsubclws=dsubclws+(zus(i,k+1)*clwtot1-zus(i,k)*clwtot)*g/dp
! endif
! tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) &
! +outqcm(i,k)*cutenm(i) &
! +dsubclw*xmb(i)+dsubclws*xmbs(i)+dsubclwm*xmbm(i) &
! )
! tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf))
! if (clcw(i,k) .gt. -999.0) then
! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice
! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water
! else
! cliw(i,k) = max(0.,cliw(i,k) + tem)
! endif
!
! enddo

!> - FCT treats subsidence effect to cloud ice/water (begin)
dp=100.*(p2d(i,k)-p2d(i,k+1))
Expand Down Expand Up @@ -1015,8 +982,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,&
gdc(i,16,10)=pret(i)*3600.

maxupmf(i)=0.
if(forcing(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing(i,6))
if(forcing2(i,6).gt.0.)then
maxupmf(i)=maxval(xmb(i)*zu(i,kts:ktf)/forcing2(i,6))
endif

if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i))
Expand Down
9 changes: 4 additions & 5 deletions physics/cu_gf_driver_post.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,20 +66,19 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m
conv_act_m(i)=0.0
endif
! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f)
if(sqrt(garea(i)).lt.6500.)then
ze = 0.0
ze_conv = 0.0
dbz_sum = 0.0
cuprate = raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
ze_conv = 300.0 * cuprate**1.4
if (maxupmf(i).gt.0.05) then
cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h)
if(cuprate .lt. 0.05) cuprate=0.
ze_conv = 300.0 * cuprate**1.5
if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then
do k = 1, km
ze = 10._kind_phys ** (0.1 * refl_10cm(i,k))
dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv))
refl_10cm(i,k) = dbz_sum
enddo
endif
endif
enddo
!$acc end kernels

Expand Down
32 changes: 11 additions & 21 deletions physics/smoke_dust/dust_data_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,24 +44,10 @@ module dust_data_mod
! Never used:
! real(kind_phys), parameter :: fengsha_alpha = 0.3
! real(kind_phys), parameter :: fengsha_gamma = 1.3

! -- FENGSHA threshold velocities based on Dale A. Gillette's data
integer, parameter :: fengsha_maxstypes = 13
! real(kind_phys), dimension(fengsha_maxstypes) :: dust_uthres = &
! (/ 0.065, & ! Sand - 1
! 0.20, & ! Loamy Sand - 2
! 0.52, & ! Sandy Loam - 3
! 0.50, & ! Silt Loam - 4
! 0.50, & ! Silt - 5
! 0.60, & ! Loam - 6
! 0.73, & ! Sandy Clay Loam - 7
! 0.73, & ! Silty Clay Loam - 8
! 0.80, & ! Clay Loam - 9
! 0.95, & ! Sandy Clay - 10
! 0.95, & ! Silty Clay - 11
! 1.00, & ! Clay - 12
! 9.999 /) ! Other - 13
! dust_uthres = 0.065, 0.18, 0.27, 0.30, 0.35, 0.38, 0.35, 0.41, 0.41,
! 0.45,0.50,0.45,9999.0

real(kind_phys), dimension(fengsha_maxstypes), parameter :: dust_uthres = &
(/ 0.065, & ! Sand - 1
0.18, & ! Loamy Sand - 2
Expand All @@ -76,12 +62,16 @@ module dust_data_mod
0.50, & ! Silty Clay - 11
0.45, & ! Clay - 12
9999.0 /) ! Other - 13
! -- FENGSHA uses precalculated drag partition from ASCAT. See: Prigent et al. (2012,2015)
integer, parameter :: dust_calcdrag = 1

real(kind_phys) :: dust_alpha = 2.2
! -- FENGSHA uses precalculated drag partition
integer, parameter :: dust_calcdrag = 1
! -- FENGSHA dust moisture parameterization 1:fecan - 2:shao
integer :: dust_moist_opt = 1

real(kind_phys) :: dust_alpha = 1.0
real(kind_phys) :: dust_gamma = 1.0

real(kind_phys) :: dust_moist_correction = 1.0
real(kind_phys) :: dust_drylimit_factor = 1.0

! -- sea salt parameters
integer, dimension(nsalt), parameter :: spoint = (/ 1, 2, 2, 2, 2, 2, 3, 3, 3 /) ! 1 Clay, 2 Silt, 3 Sand
Expand All @@ -93,7 +83,7 @@ module dust_data_mod
(/ 1., 0.2, 0.2, 0.2, 0.2, 0.2, 0.333, 0.333, 0.333 /)


! -- soil vagatation parameters
! -- soil vegatation parameters
integer, parameter :: max_soiltyp = 30
real(kind_phys), dimension(max_soiltyp), parameter :: &
maxsmc = (/ 0.421, 0.464, 0.468, 0.434, 0.406, 0.465, &
Expand Down
Loading

0 comments on commit 609c90b

Please sign in to comment.