From cb2d558dcc2fbd984a82569edcfe04b749bebeb8 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 09:48:20 -0600 Subject: [PATCH 1/3] fix unitialized parameter and dimensions in FA --- physics/GFS_rrtmg_pre.F90 | 8 ++++++-- physics/module_MP_FER_HIRES.F90 | 8 +++++++- physics/mp_fer_hires.F90 | 4 ++++ physics/radiation_clouds.f | 9 ++++----- 4 files changed, 21 insertions(+), 8 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 8acb24a50..af2cb0093 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -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 @@ -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), & diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index f45ffa04f..c758f7951 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -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 !----------------------------------------------------------------------- @@ -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 diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 19cfa117a..4935d8aa6 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -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 !--------------------------------------------------------------------- diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 0d3f75c71..65f483821 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -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, & @@ -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 @@ -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. @@ -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 From b084396e1fe3947f26b3903029ff28253620e996 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 12:20:25 -0600 Subject: [PATCH 2/3] fix unitialized parameters in samfdeepcnv --- physics/samfdeepcnv.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index f64a0b332..d067d7187 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -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) @@ -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) @@ -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) From d35fad0f27a7cd3b38e49351ba9d1d3f8e10bbff Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 15:42:18 -0600 Subject: [PATCH 3/3] bug fix in HWRF RRTMG --- physics/radlw_main.F90 | 11 +++++++---- physics/radsw_main.F90 | 4 ++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 4ee7ca22b..f5278ed33 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -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 @@ -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 & & ) @@ -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 & ) @@ -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, & @@ -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, & @@ -1962,6 +1964,7 @@ subroutine cldprop & endif enddo enddo + endif !iovrlw endif ! end if_isubclw_block diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 924d750b1..321414976 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -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