Skip to content

Commit

Permalink
Merge pull request #447 from mzhangw/dtc_hwrf_physics
Browse files Browse the repository at this point in the history 
Bug fix in FA, HWRF RRTMG and HWRF SAS.
  • Loading branch information
@climbfuji
climbfuji authored May 6, 2020
2 parents 08bcc39 + d35fad0 commit eddf41c
Show file tree
Hide file tree
Showing 7 changed files with 33 additions and 17 deletions.
8 changes: 6 additions & 2 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -566,7 +566,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water
ccnd(i,k,2) = tracer1(i,k,ntiw) ! ice water
ccnd(i,k,3) = tracer1(i,k,ntrw) ! rain water
ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + grapuel
if (Model%imp_physics == 15 ) then
ccnd(i,k,4) = 0.0
else
ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + grapuel
endif
enddo
enddo
endif
Expand Down Expand Up @@ -859,7 +863,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
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, &
!mz ntsw-1,ntgl-1, &
im, lmk, lmp, Model%icloud,Model%uni_cld, &
Model%lmfshal,Model%lmfdeep2, &
cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), &
Expand Down
8 changes: 7 additions & 1 deletion physics/module_MP_FER_HIRES.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -289,7 +289,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
REAL, DIMENSION(ims:ime):: APREC,PREC,ACPREC

INTEGER :: I,K,KK
REAL :: wc
REAL :: wc, RDIS, BETA6
!------------------------------------------------------------------------
! For subroutine EGCP01COLUMN_hr
!-----------------------------------------------------------------------
Expand Down Expand Up @@ -331,6 +331,12 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!
!-- See comments in subroutine etanewhr_init starting with variable RDIS=
!
!-- Relative dispersion == standard deviation of droplet spectrum / mean radius
! (see pp 1542-1543, Liu & Daum, JAS, 2004)
RDIS=0.5 !-- relative dispersion of droplet spectrum
BETA6=( (1.+3.*RDIS*RDIS)*(1.+4.*RDIS*RDIS)*(1.+5.*RDIS*RDIS)/ &
& ((1.+RDIS*RDIS)*(1.+2.*RDIS*RDIS) ) )

BRAUT=DT*1.1E10*BETA6/NCW

!! END OF adding, 2015-03-30
Expand Down
4 changes: 4 additions & 0 deletions physics/mp_fer_hires.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -274,10 +274,14 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &

!---------------------------------------------------------------------
!aligo
DO K = 1, LM
DO I= IMS, IME
cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k))
qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k))
qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k))
qc(i,k) = qc(i,k)/(1.0_kind_phys-q(i,k))
ENDDO
ENDDO
!aligo
!---------------------------------------------------------------------

Expand Down
9 changes: 4 additions & 5 deletions physics/radiation_clouds.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2275,7 +2275,7 @@ end subroutine progcld4o
subroutine progcld5 &
& ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs:
& xlat,xlon,slmsk,dz,delp, &
& ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, &
& ntrac,ntcw,ntiw,ntrw, &
& IX, NLAY, NLP1, icloud, &
& uni_cld, lmfshal, lmfdeep2, cldcov, &
& re_cloud,re_ice,re_snow, &
Expand Down Expand Up @@ -2364,7 +2364,7 @@ subroutine progcld5 &

! --- inputs
integer, intent(in) :: IX, NLAY, NLP1, ICLOUD
integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl
integer, intent(in) :: ntrac, ntcw, ntiw, ntrw

logical, intent(in) :: uni_cld, lmfshal, lmfdeep2

Expand Down Expand Up @@ -2452,7 +2452,7 @@ subroutine progcld5 &

do k = 1, NLAY
do i = 1, IX
clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw)
clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw)
enddo
enddo
!> - Find top pressure for each cloud domain for given latitude.
Expand All @@ -2479,8 +2479,7 @@ subroutine progcld5 &
cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k))
cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k))
crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k))
csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * &
& gfac * delp(i,k))
csp(i,k) = 0.0
enddo
enddo

Expand Down
11 changes: 7 additions & 4 deletions physics/radlw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -670,7 +670,7 @@ subroutine rrtmg_lw_run &

real (kind=kind_phys), dimension(nlay,nbands) :: htrb
real (kind=kind_phys), dimension(nbands,nlay) :: taucld, tauaer
real (kind=kind_phys), dimension(nbands,1,nlay) :: taucld3
real (kind=kind_phys), dimension(nbands,npts,nlay) :: taucld3
real (kind=kind_phys), dimension(ngptlw,nlay) :: fracs, tautot
real (kind=kind_phys), dimension(nlay,ngptlw) :: fracs_r
!mz rtrnmc_mcica
Expand Down Expand Up @@ -1175,7 +1175,7 @@ subroutine rrtmg_lw_run &
call cldprop &
! --- inputs:
& ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, &
& nlay, nlp1, ipseed(iplon), dz, delgth, &
& nlay, nlp1, ipseed(iplon), dz, delgth,iovrlw, &
! --- outputs:
& cldfmc, taucld &
& )
Expand Down Expand Up @@ -1668,7 +1668,7 @@ end subroutine rlwinit
!> @{
subroutine cldprop &
& ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs
& nlay, nlp1, ipseed, dz, de_lgth, &
& nlay, nlp1, ipseed, dz, de_lgth, iovrlw, &
& cldfmc, taucld & ! --- outputs
& )

Expand Down Expand Up @@ -1768,7 +1768,7 @@ subroutine cldprop &
use module_radlw_cldprlw

! --- inputs:
integer, intent(in) :: nlay, nlp1, ipseed
integer, intent(in) :: nlay, nlp1, ipseed, iovrlw

real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac
real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, &
Expand Down Expand Up @@ -1946,6 +1946,8 @@ subroutine cldprop &

! --- ... call sub-column cloud generator

!mz*
if (iovrlw .ne. 4) then
call mcica_subcol &
! --- inputs:
& ( cldf, nlay, ipseed, dz, de_lgth, &
Expand All @@ -1962,6 +1964,7 @@ subroutine cldprop &
endif
enddo
enddo
endif !iovrlw

endif ! end if_isubclw_block

Expand Down
4 changes: 2 additions & 2 deletions physics/radsw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -720,9 +720,9 @@ subroutine rrtmg_sw_run &

! --- locals:
!mz* HWRF -- input of mcica_subcol_sw
real(kind=kind_phys),dimension(1,nlay) :: hgt
real(kind=kind_phys),dimension(npts,nlay) :: hgt
real(kind=kind_phys) :: dzsum
real(kind=kind_phys),dimension( nbdsw, 1, nlay ) :: taucld3, &
real(kind=kind_phys),dimension( nbdsw, npts, nlay ) :: taucld3, &
ssacld3, &
asmcld3, &
fsfcld3
Expand Down
6 changes: 3 additions & 3 deletions physics/samfdeepcnv.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -201,7 +201,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, &
c physical parameters
! parameter(asolfac=0.89) !HWRF
! parameter(grav=grav)
! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp))
! parameter(c0s=.002,c1=.002,d0=.01)
! parameter(d0=.01)
parameter(d0=.001)
Expand All @@ -215,7 +215,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, &
! as Nccn=100 for sea and Nccn=1000 for land
!
parameter(cm=1.0)
! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c)
! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c)
parameter(clamd=0.03,tkemx=0.65,tkemn=0.05)
parameter(dtke=tkemx-tkemn)
parameter(dbeta=0.1)
Expand Down Expand Up @@ -276,13 +276,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, &
errflg = 0


if(.not. hwrf_samfdeep) then
elocp = hvap/cp
el2orc = hvap*hvap/(rv*cp)

fact1 = (cvap-cliq)/rv
fact2 = hvap/rv-fact1*t0c
!
if(.not. hwrf_samfdeep) then
c-----------------------------------------------------------------------
!> ## Determine whether to perform aerosol transport
do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0)
Expand Down

0 comments on commit eddf41c

Please sign in to comment.