Skip to content

Commit

Permalink
Merge remote-tracking branch 'remotes/rsun/feature_gfdlmpv3' into fea…
Browse files Browse the repository at this point in the history
…ture/hafsv2_gfdlmpv3
  • Loading branch information
BinLiu-NOAA committed Feb 21, 2024
2 parents e42ac90 + 3e31927 commit e03f043
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 115 deletions.
109 changes: 8 additions & 101 deletions physics/MP/GFDL_2022_v3/gfdl_cld_mp_v3.F90
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,7 @@ subroutine gfdl_cld_mp_v3_run(

logical, intent (in) :: lradar
real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm
logical, intent (in) :: reset, effr_in !rsun reset could be removed
logical, intent (in) :: reset, effr_in
real(kind=kind_phys), intent(inout), dimension(:,:) :: rew, rei, rer, res, reg
logical, intent (in) :: cplchm
! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true.
Expand All @@ -183,7 +183,7 @@ subroutine gfdl_cld_mp_v3_run(
real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls
real(kind=kind_phys), dimension(1:im,1,1:levs) :: adj_vmr, te
real(kind=kind_phys), dimension(1:im,1:levs) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg
real(kind=kind_phys), dimension(1:im) :: dte, hs
real(kind=kind_phys), dimension(1:im) :: dte, hs, gsize
!real(kind=kind_phys), dimension(:,:), allocatable :: den
real(kind=kind_phys), dimension(1:im) :: water0
real(kind=kind_phys) :: onebg
Expand Down Expand Up @@ -222,7 +222,6 @@ subroutine gfdl_cld_mp_v3_run(
qnl(i,k) = aerfld(i,kk,11) ! sulfate
pfils(i,1,k) = 0.0
pflls(i,1,k) = 0.0
!rsun intitialize pfluxi etc take a look at the SHield driver
prefluxw(i,k) =0.0
prefluxi(i,k) =0.0
prefluxr(i,k) =0.0
Expand All @@ -238,28 +237,14 @@ subroutine gfdl_cld_mp_v3_run(
qg1(i,k) = gq0_ntgl(i,kk)
qa1(i,k) = gq0_ntclamt(i,kk)
pt(i,k) = gt0(i,kk)
!rsun WW defined here is differnce from what is used in SHiELD (https://github.com/NOAA-GFDL/SHiELD_physics/blob/main/GFS_layer/GFS_physics_driver.F90)
w(i,k) = -vvl(i,kk) * (one+con_fvirt * gq0(i,kk)) &
* gt0(i,kk) / prsl(i,kk) * (con_rd*onebg)
uin(i,k) = gu0(i,kk)
vin(i,k) = gv0(i,kk)
delp(i,k) = del(i,kk)
dz(i,k) = (phii(i,kk)-phii(i,kk+1))*onebg
p123(i,k) = prsl(i,kk)
!tem = con_eps*prsl(i,kk)/(con_rd*gt0(i,kk)*(gq0(i,kk)+con_eps))
!if(tem <0.0) then
! write(errmsg,'(*(a))') 'Negative air density associated with GFDL MP v3'
! errflg = 1
! return
!endif
!qni(i,k) = 10./tem
qni(i,k) = 10.
!rsun debug
! if(i == 1) then
! write(*,*) 'T, qnl, qni:',k,p123(i,k),pt(i,k),qnl(i,k), qni(i,k)
! endif

!rsun for inline option
q_con(i,k) = 0.0
cappa(i,k) = 0.0
enddo
Expand All @@ -272,55 +257,19 @@ subroutine gfdl_cld_mp_v3_run(
snow0 = 0
graupel0 = 0

! if(imp_physics == imp_physics_gfdl) then
!
! call gfdl_cloud_microphys_mod_driver(iis, iie, jjs, jje, kks, kke, ktop, kbot, &
! qv1, ql1, qr1, qi1, qs1, qg1, qa1, qnl, qv_dt, ql_dt, qr_dt, qi_dt, &
! qs_dt, qg_dt, qa_dt, pt_dt, pt, w, uin, vin, u_dt, v_dt, dz, delp, &
! garea, dtp, frland, rain0, snow0, ice0, graupel0, hydrostatic, &
! phys_hydrostatic, p123, lradar, refl, reset, pfils, pflls)
!
! else if (imp_physics == imp_physics_gfdl_v3) then
if(imp_physics == imp_physics_gfdl_v3) then

!rsun attention to flipping (same as v1 driver: need to be from top to bottom : 1,km)
!rsun : variables defined in shield
! need to pass water out
! hs = Sfcprop%oro(:) * con_g
! gsize = sqrt(Grid%area(:))
! w (:,k) = -Statein%vvl(:,levs-k+1)*con_rd*Stateout%gt0(:,levs-k+1) &
! & /Statein%prsl(:,levs-k+1)/con_g
! delp (:,k) = del(:,levs-k+1)
! dz (:,k) = (Statein%phii(:,levs-k+1)-Statein%phii(:,levs-k+2))/con_g
!
! turn off the or remove the inline option
! define consv_te a logical variable as input only
! define adj_vmr output only

!fast_mp_consv = .false.
!last_step = .true.

last_step = .false.
do_inline_mp = .false.
hs = oro(:) * con_g
gsize = sqrt(garea(:))

call module_gfdl_cld_mp_driver( qv1, ql1, qr1, qi1, qs1, qg1, qa1, qnl, qni, pt, w,&
uin, vin, dz, delp, garea, dtp, hs, water0, rain0, &
uin, vin, dz, delp, gsize, dtp, hs, water0, rain0, &
ice0, snow0, graupel0, hydrostatic, iis, iie, kks, kke, q_con, cappa, &
fast_mp_consv, adj_vmr, te, dte, prefluxw, prefluxr, prefluxi, prefluxs, &
prefluxg, last_step, do_inline_mp )

!if(lradar) refl = -20.0 !call rad_ref or call refl10cm_gfdl from GFDLMP V1

!make sure the unit of water0, rain0, ice0, snow0, graupel0, are the same as in V1 mm/day?
! find how to define them in module_gfdl_cloud_microphys.F90
! need to add call refl calculation to calulate refl call rad_ref
!
! rsun check to make sure the variables going out of the routine
! the following list of variables can be calcualted here
! (no need for the following variables (the variables are updated in the gfdl_cld_mp_mod_driver)
! pt_dt, qa_dt, u_dt, v_dt, qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt
! take a look how qnl and qi1 are initialized

else
write(errmsg,'(*(a))') 'Invalid imp_physics option for GFDL MP v3'
errflg = 1
Expand Down Expand Up @@ -370,28 +319,11 @@ subroutine gfdl_cld_mp_v3_run(
snow0 = snow0*tem
graupel0 = graupel0*tem

!rsun: move this after the call of the each driver

! flip vertical coordinate back
do k=1,levs
kk = levs-k+1
do i=1,im

!rsun add update the following fields only for v1
! if (imp_physics == imp_physics_gfdl) then
!
! gq0(i,k) = qv1(i,kk) + qv_dt(i,kk) * dtp
! gq0_ntcw(i,k) = ql1(i,kk) + ql_dt(i,kk) * dtp
! gq0_ntrw(i,k) = qr1(i,kk) + qr_dt(i,kk) * dtp
! gq0_ntiw(i,k) = qi1(i,kk) + qi_dt(i,kk) * dtp
! gq0_ntsw(i,k) = qs1(i,kk) + qs_dt(i,kk) * dtp
! gq0_ntgl(i,k) = qg1(i,kk) + qg_dt(i,kk) * dtp
! gq0_ntclamt(i,k) = qa1(i,kk) + qa_dt(i,kk) * dtp
! gt0(i,k) = gt0(i,k) + pt_dt(i,kk) * dtp
! gu0(i,k) = gu0(i,k) + u_dt(i,kk) * dtp
! gv0(i,k) = gv0(i,k) + v_dt(i,kk) * dtp
! refl_10cm(i,k) = refl(i,kk)
!else if(imp_physics == imp_physics_gfdl_v3) then
if (imp_physics == imp_physics_gfdl_v3) then
gq0(i,k) = qv1(i,kk)
gq0_ntcw(i,k) = ql1(i,kk)
Expand All @@ -400,7 +332,7 @@ subroutine gfdl_cld_mp_v3_run(
gq0_ntsw(i,k) = qs1(i,kk)
gq0_ntgl(i,k) = qg1(i,kk)
gq0_ntclamt(i,k) = qa1(i,kk)
gt0(i,k) = pt(i,kk) ! rsun double check this
gt0(i,k) = pt(i,kk)
gu0(i,k) = uin(i,kk)
gv0(i,k) = vin(i,kk)
refl_10cm(i,k) = refl(i,kk)
Expand All @@ -417,16 +349,9 @@ subroutine gfdl_cld_mp_v3_run(
do k=1,levs
kk = levs-k+1
do i=1,im
!if(imp_physics==imp_physics_gfdl) then
! pfi_lsan(i,k) = pfils(i,1,kk) !rsun this need special attention to have the same variable in v3
! pfl_lsan(i,k) = pflls(i,1,kk)
!else if (imp_physics==imp_physics_gfdl_v3) then
if (imp_physics==imp_physics_gfdl_v3) then

!rsun make sure prefluxw is the same as pfils

pfi_lsan(i,k) = prefluxi (i,kk) + prefluxs (i,kk) + prefluxg (i,kk)! rsun: use the same unit as pfils
pfl_lsan(i,k) = prefluxr (i,kk) ! rsun
pfi_lsan(i,k) = prefluxi (i,kk) + prefluxs (i,kk) + prefluxg (i,kk)
pfl_lsan(i,k) = prefluxr (i,kk)
else
write(errmsg,'(*(a))') 'Invalid imp_physics option for GFDL MP v3'
errflg = 1
Expand All @@ -437,21 +362,6 @@ subroutine gfdl_cld_mp_v3_run(
endif

if(effr_in) then
!allocate(den(1:im,1:levs))
!do k=1,levs
! do i=1,im
! den(i,k)=con_eps*prsl(i,k)/(con_rd*gt0(i,k)*(gq0(i,k)+con_eps))
! enddo
!enddo
!call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), &
! del(1:im,1:levs), islmsk(1:im), &
! gq0_ntcw(1:im,1:levs), gq0_ntiw(1:im,1:levs), &
! gq0_ntrw(1:im,1:levs), &
! gq0_ntsw(1:im,1:levs) + gq0_ntgl(1:im,1:levs), &
! gq0_ntgl(1:im,1:levs)*0.0, gt0(1:im,1:levs), &
! rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),&
! res(1:im,1:levs), reg(1:im,1:levs))
!deallocate(den)
call cld_eff_rad (1, im, 1, levs, slmsk(1:im), &
prsl(1:im,1:levs), del(1:im,1:levs), &
gt0(1:im,1:levs), gq0(1:im,1:levs), &
Expand All @@ -463,9 +373,6 @@ subroutine gfdl_cld_mp_v3_run(
endif

if(lradar) then
! need peln, zvir; print and check
! need to use qv1 etc (top 1 and bottom 127)
! make sure the consistency between peln, zvir and qv1 etc
call rad_ref (1, im, 1, 1, qv1(1:im,1:levs), qr1(1:im,1:levs), &
qs1(1:im,1:levs),qg1(1:im,1:levs),pt(1:im,1:levs), &
delp(1:im,1:levs), dz(1:im,1:levs), refl(1:im,1:levs), levs, hydrostatic, &
Expand Down
15 changes: 1 addition & 14 deletions physics/MP/GFDL_2022_v3/module_gfdl_cld_mp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -391,8 +391,7 @@ module module_gfdl_cld_mp
real :: tau_v2l = 150.0 ! water vapor to cloud water condensation time scale (s)
real :: tau_l2v = 300.0 ! cloud water to water vapor evaporation time scale (s)
real :: tau_revp = 0.0 ! rain evaporation time scale (s)
!rsun real :: tau_imlt = 1200.0 ! cloud ice melting time scale (s) ! ori in v3
real :: tau_imlt = 600.0 ! cloud ice melting time scale (s) ! 600.0 is the origin in v1
real :: tau_imlt = 1200.0 ! cloud ice melting time scale (s)
real :: tau_smlt = 900.0 ! snow melting time scale (s)
real :: tau_gmlt = 600.0 ! graupel melting time scale (s)
real :: tau_wbf = 300.0 ! graupel melting time scale (s)
Expand Down Expand Up @@ -1367,8 +1366,6 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, &

enddo

!rsun ke is sufface

do k = ks, ke
denfac (k) = sqrt (den (ke) / den (k))
enddo
Expand Down Expand Up @@ -1608,10 +1605,6 @@ subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, &
qg (i, k) = qgz (k)
qa (i, k) = qaz (k)

!rsun
!if(qaz(k) > 0.0) print*,'qa(i,k):',i,k, qaz(k)


! -----------------------------------------------------------------------
! calculate some more variables needed outside
! -----------------------------------------------------------------------
Expand Down Expand Up @@ -6065,11 +6058,6 @@ subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg,
enddo
endif


!print*,'cld_eff_rad: radius option:',rewflag, reiflag, resflag, rerflag, regflag: 1 2 1 1 1
!print*,'in cld_eff_rad:ccn_o, ccn_l:',ccn_o, ccn_l


do i = is, ie

do k = ks, ke
Expand Down Expand Up @@ -6481,7 +6469,6 @@ subroutine rad_ref (is, ie, js, je, qv, qr, qs, qg, pt, delp, &
! -----------------------------------------------------------------------

do k = 1, npz
! rsun: find more about this
!if (hydrostatic) then
! den (k) = delp (i, j, k) / ((peln (i, k + 1, j) - peln (i, k, j)) * &
! rdgas * pt (i, j, k) * (1. + zvir * qv (i, j, k)))
Expand Down

0 comments on commit e03f043

Please sign in to comment.