Skip to content

Commit

Permalink
FA uses progcld5
Browse files Browse the repository at this point in the history
  • Loading branch information
@mzhangw
mzhangw committed Apr 14, 2020
1 parent 682fab9 commit 406f740
Showing 1 changed file with 162 additions and 70 deletions.
232 changes: 162 additions & 70 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ end subroutine GFS_rrtmg_pre_init
! in the CCPP version - they are defined in the interstitial_create routine
subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Tbd, Cldprop, Coupling, &
Radtend, & ! input/output
Radtend, dx, & ! input/output
f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only
lm, im, lmk, lmp, & ! input
kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output
Expand All @@ -35,39 +35,47 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
mtopa, mbota, de_lgth, alb1d, errmsg, errflg)

use machine, only: kind_phys
use GFS_typedefs, only: GFS_statein_type, &
GFS_stateout_type, &
GFS_sfcprop_type, &
GFS_coupling_type, &
GFS_control_type, &
GFS_grid_type, &
GFS_tbd_type, &
GFS_cldprop_type, &
GFS_radtend_type, &
use GFS_typedefs, only: GFS_statein_type, &
GFS_stateout_type, &
GFS_sfcprop_type, &
GFS_coupling_type, &
GFS_control_type, &
GFS_grid_type, &
GFS_tbd_type, &
GFS_cldprop_type, &
GFS_radtend_type, &
GFS_diag_type
use physparam
use physcons, only: eps => con_eps, &
& epsm1 => con_epsm1, &
& fvirt => con_fvirt &
&, rog => con_rog &
&, rocp => con_rocp
epsm1 => con_epsm1, &
fvirt => con_fvirt, &
rog => con_rog, &
rocp => con_rocp, &
con_rd
use radcons, only: itsfc,ltp, lextop, qmin, &
qme5, qme6, epsq, prsmin
use funcphys, only: fpvs

use module_radiation_astronomy,only: coszmn ! sol_init, sol_update
use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update,
use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update,
& NSPC1
use module_radiation_clouds, only: NF_CLDS, & ! cld_init
& progcld1, progcld3, &
& progcld2, &
& progcld4, progcld5, &
& progclduni
use module_radsw_parameters, only: topfsw_type, sfcfsw_type, &
& profsw_type, NBDSW
use module_radlw_parameters, only: topflw_type, sfcflw_type, &
& proflw_type, NBDLW
use module_radiation_astronomy,only: coszmn ! sol_init, sol_update
use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update,
use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update,
NSPC1
use module_radiation_clouds, only: NF_CLDS, & ! cld_init
progcld1, progcld3, &
progcld2, &
progcld4, progcld5, &
progcld6, & ! F-A
progclduni, &
cal_cldfra3, &
find_cloudLayers, &
adjust_cloudIce, &
adjust_cloudH2O, &
adjust_cloudFinal

use module_radsw_parameters, only: topfsw_type, sfcfsw_type, &
profsw_type, NBDSW
use module_radlw_parameters, only: topflw_type, sfcflw_type, &
proflw_type, NBDLW
use surface_perturbation, only: cdfnor

implicit none
Expand All @@ -77,22 +85,22 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
type(GFS_sfcprop_type), intent(in) :: Sfcprop
type(GFS_statein_type), intent(in) :: Statein
type(GFS_radtend_type), intent(inout) :: Radtend
type(GFS_tbd_type), intent(in) :: Tbd
type(GFS_tbd_type), intent(inout) :: Tbd
type(GFS_cldprop_type), intent(in) :: Cldprop
type(GFS_coupling_type), intent(in) :: Coupling

integer, intent(in) :: im, lm, lmk, lmp
integer, intent(out) :: kd, kt, kb
integer, intent(in) :: im, lm, lmk, lmp
integer, intent(out) :: kd, kt, kb

! F-A mp scheme only
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm
real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm
real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin
real(kind=kind_phys), intent(out) :: raddt


real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: dx
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl
Expand Down Expand Up @@ -146,25 +154,32 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input

integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb

real(kind=kind_phys) :: es, qs, delt, tem0d
real(kind=kind_phys) :: es, qs, delt, tem0d, gridkm

real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn
real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn, xland

real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: &
htswc, htlwc, gcice, grain, grime, htsw0, htlw0, &
rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, &
cldcov, deltaq, cnvc, cnvw, &
effrl, effri, effrr, effrs
effrl, effri, effrr, effrs, rho, plyrpa

real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db
! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qc_save
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qi_save
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qs_save

real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw

integer :: ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte

!
!===> ... begin here
!
Expand All @@ -175,8 +190,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
if (.not. (Model%lsswr .or. Model%lslwr)) return

!--- set commonly used integers
me = Model%me
NFXR = Model%nfxr
me = Model%me
NFXR = Model%nfxr
NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC)
ntcw = Model%ntcw
ntiw = Model%ntiw
Expand Down Expand Up @@ -529,7 +544,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice
enddo
enddo
elseif (Model%ncnd == 2) then ! MG or F-A
elseif (Model%ncnd == 2) then ! MG
do k=1,LMK
do i=1,IM
ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water
Expand All @@ -545,7 +560,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
ccnd(i,k,4) = tracer1(i,k,ntsw) ! snow water
enddo
enddo
elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3
elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3, FA
do k=1,LMK
do i=1,IM
ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water
Expand Down Expand Up @@ -673,6 +688,72 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
enddo
endif

!mz HWRF physics: icloud=3
if(Model%icloud == 3) then

! Set internal dimensions
ids = 1
ims = 1
its = 1
ide = size(Grid%xlon,1)
ime = size(Grid%xlon,1)
ite = size(Grid%xlon,1)
jds = 1
jms = 1
jts = 1
jde = 1
jme = 1
jte = 1
kds = 1
kms = 1
kts = 1
kde = Model%levr+LTP
kme = Model%levr+LTP
kte = Model%levr+LTP

do k = 1, LMK
do i = 1, IM
rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k))
plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa
end do
end do

do i=1,im
if (Sfcprop%slmsk(i)==1. .or. Sfcprop%slmsk(i)==2.) then ! sea/land/ice mask (=0/1/2) in FV3
xland(i)=1.0 ! but land/water = (1/2) in HWRF
else
xland(i)=2.0
endif
enddo

gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001)

do i =1, im
do k =1, lmk
qc_save(i,k) = ccnd(i,k,1)
qi_save(i,k) = ccnd(i,k,2)
qs_save(i,k) = ccnd(i,k,4)
enddo
enddo


call cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), &
ccnd(:,:,4),plyrpa,tlyr,rho,xland,gridkm, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)

!mz* back to micro-only qc qi,qs
do i =1, im
do k =1, lmk
ccnd(i,k,1) = qc_save(i,k)
ccnd(i,k,2) = qi_save(i,k)
ccnd(i,k,4) = qs_save(i,k)
enddo
enddo

endif ! icloud == 3

if (lextop) then
do i=1,im
cldcov(i,lyb) = cldcov(i,lya)
Expand Down Expand Up @@ -727,18 +808,18 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
elseif (Model%imp_physics == 11) then ! GFDL cloud scheme

if (.not.Model%lgfdlmprad) then
call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), cnvw, cnvc, &
Grid%xlat, Grid%xlon, Sfcprop%slmsk, &
cldcov, dz, delp, im, lmk, lmp, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
ccnd(1:IM,1:LMK,1), cnvw, cnvc, &
Grid%xlat, Grid%xlon, Sfcprop%slmsk, &
cldcov, dz, delp, im, lmk, lmp, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
else

call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs
Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, &
IM, LMK, LMP, cldcov, &
effrl, effri, effrr, effrs, Model%effr_in, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs
Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, &
IM, LMK, LMP, cldcov, &
effrl, effri, effrr, effrs, Model%effr_in, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs
! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, &
! dz, delp, &
Expand All @@ -748,31 +829,42 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
endif

elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then
elseif(Model%imp_physics == 8) then
if (Model%kdt == 1) then
Tbd%phy_f3d(:,:,Model%nleffr) = 10.
Tbd%phy_f3d(:,:,Model%nieffr) = 50.
Tbd%phy_f3d(:,:,Model%nseffr) = 250.
endif

call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs
Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lmk, lmp, Model%uni_cld, &
Model%lmfshal,Model%lmfdeep2, &
cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), &
Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), &
clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs
! mz* this is the original progcld5 - temporary
! will be replaced with GSL's version of progcld6 for Thompson MP
call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs
Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lmk, lmp, Model%uni_cld, &
Model%lmfshal,Model%lmfdeep2, &
cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), &
Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), &
clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs


elseif(Model%imp_physics == 15) then
call progcld2 (plyr,plvl,tlyr,qlyr,qstl,rhly,tvly,tracer1,& ! --- inputs
Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
im, lmk, lmp, &
Model%lmfshal,Model%lmfdeep2, &
if (Model%kdt == 1) then
Tbd%phy_f3d(:,:,Model%nleffr) = 10.
Tbd%phy_f3d(:,:,Model%nieffr) = 50.
Tbd%phy_f3d(:,:,Model%nseffr) = 250.
endif

call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1, & ! --- inputs
Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
ntsw-1,ntgl-1, &
im, lmk, lmp, Model%icloud,Model%uni_cld, &
Model%lmfshal,Model%lmfdeep2, &
cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), &
Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), &
clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs
! --- output

endif ! end if_imp_physics

Expand Down

0 comments on commit 406f740

Please sign in to comment.