diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index c45bec3e3..4f4de181a 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -18,7 +18,7 @@ module GFS_rrtmg_pre !! !>\section rrtmg_pre_gen General Algorithm subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& - ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_unified, me, ncnd, ntrac, & + ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac, & num_p3d, npdf3d, & ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm, & @@ -44,7 +44,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, & gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & - faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, & + faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, & aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, errmsg, errflg) use machine, only: kind_phys @@ -84,7 +84,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: im, levs, lm, lmk, lmp, ltp, & n_var_lndp, imfdeepcnv, & - imfdeepcnv_gf, imfdeepcnv_unified, & + imfdeepcnv_gf, imfdeepcnv_c3, & me, ncnd, ntrac, & num_p3d, npdf3d, ncnvcld3d, ntqv, & ntcw, ntiw, ntlnc, ntinc, & @@ -126,7 +126,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& lcnorm, top_at_1, lextop, mraerosol - logical, intent(in) :: aero_dir_fdb + logical, intent(in) :: rrfs_sd, aero_dir_fdb logical, intent(in) :: nssl_ccn_on, nssl_invertccn integer, intent(in) :: spp_rad @@ -640,7 +640,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& endif !>--- add smoke and dust --- - if (aero_dir_fdb) then + if (rrfs_sd .and. aero_dir_fdb) then do k=1,lmk do i=1,im aer_nm(i,k,1 )=aer_nm(i,k,1 )+ qgrs(i,k,ntdust)*fdb_coef(1)*1.e-9 ! dust bin1 @@ -819,7 +819,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo endif elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - if ((imfdeepcnv==imfdeepcnv_gf .or. imfdeepcnv==imfdeepcnv_unified) .and. kdt>1) then + if ((imfdeepcnv==imfdeepcnv_gf .or. imfdeepcnv==imfdeepcnv_c3) .and. kdt>1) then do k=1,lm k1 = k + kd do i=1,im diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index d7feaeb3f..a8aecdbe0 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -79,9 +79,9 @@ dimensions = () type = integer intent = in -[imfdeepcnv_unified] - standard_name = identifier_for_unified_deep_convection - long_name = flag for Unified deep convection scheme +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme units = flag dimensions = () type = integer @@ -1466,6 +1466,13 @@ dimensions = () type = integer intent = in +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in [aero_dir_fdb] standard_name = do_smoke_aerosol_direct_feedback long_name = flag for smoke and dust radiation feedback diff --git a/physics/GFS_suite_interstitial_3.F90 b/physics/GFS_suite_interstitial_3.F90 index ca82f20aa..5ca20ffc1 100644 --- a/physics/GFS_suite_interstitial_3.F90 +++ b/physics/GFS_suite_interstitial_3.F90 @@ -10,8 +10,8 @@ module GFS_suite_interstitial_3 !! subroutine GFS_suite_interstitial_3_run (otsptflag, & im, levs, nn, cscnv,imfshalcnv, imfdeepcnv, & - imfshalcnv_samf, imfdeepcnv_samf, imfdeepcnv_unified, & - imfshalcnv_unified,progsigma, & + imfshalcnv_samf, imfdeepcnv_samf, imfdeepcnv_c3, & + imfshalcnv_c3,progsigma, & first_time_step, restart, & satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, & @@ -40,7 +40,7 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras, progsigma logical, intent(in ) :: first_time_step, restart integer, intent(in ) :: imfshalcnv, imfdeepcnv, imfshalcnv_samf,imfdeepcnv_samf - integer, intent(in ) :: imfshalcnv_unified,imfdeepcnv_unified + integer, intent(in ) :: imfshalcnv_c3,imfdeepcnv_c3 integer, intent(in) :: ntinc, ntlnc logical, intent(in) :: ldiag3d, qdiag3d integer, dimension(:,:), intent(in) :: dtidx @@ -84,7 +84,7 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & ! In case of using prognostic updraf area fraction, initialize area fraction here ! since progsigma_calc is called from both deep and shallow schemes. if(((imfshalcnv == imfshalcnv_samf) .or. (imfdeepcnv == imfdeepcnv_samf) & - .or. (imfshalcnv == imfshalcnv_unified) .or. (imfdeepcnv == imfdeepcnv_unified)) & + .or. (imfshalcnv == imfshalcnv_c3) .or. (imfdeepcnv == imfdeepcnv_c3)) & .and. progsigma)then if(first_time_step .and. .not. restart)then do k=1,levs diff --git a/physics/GFS_suite_interstitial_3.meta b/physics/GFS_suite_interstitial_3.meta index a6d656a75..e8f9fe889 100644 --- a/physics/GFS_suite_interstitial_3.meta +++ b/physics/GFS_suite_interstitial_3.meta @@ -57,9 +57,9 @@ dimensions = () type = integer intent = in -[imfdeepcnv_unified] - standard_name = identifier_for_unified_deep_convection - long_name = flag for Unified deep convection scheme +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme units = flag dimensions = () type = integer @@ -78,9 +78,9 @@ dimensions = () type = integer intent = in -[imfshalcnv_unified] - standard_name = identifier_for_unified_shallow_convection - long_name = flag for Unified shallow convection scheme +[imfshalcnv_c3] + standard_name = identifier_for_c3_shallow_convection + long_name = flag for C3 shallow convection scheme units = flag dimensions = () type = integer @@ -542,4 +542,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/cu_unified_deep.F90 b/physics/cu_c3_deep.F90 similarity index 94% rename from physics/cu_unified_deep.F90 rename to physics/cu_c3_deep.F90 index a6be5c450..c3a4b2c4e 100644 --- a/physics/cu_unified_deep.F90 +++ b/physics/cu_c3_deep.F90 @@ -1,7 +1,7 @@ -!>\file cu_unified_deep.F90 -!! This file is the unified deep convection scheme. +!>\file cu_c3_deep.F90 +!! This file is the C3 deep convection scheme. -module cu_unified_deep +module cu_c3_deep use machine , only : kind_phys use progsigma, only : progsigma_calc @@ -27,9 +27,10 @@ module cu_unified_deep real(kind=kind_phys), parameter :: pgcd = 0.1 ! !> aerosol awareness, do not use yet! - integer, parameter :: autoconv=1 - integer, parameter :: aeroevap=1 + integer, parameter :: autoconv=1 !2 + integer, parameter :: aeroevap=1 !3 real(kind=kind_phys), parameter :: scav_factor = 0.5 + real(kind=kind_phys), parameter :: dx_thresh = 6500. !> still 16 ensembles for clousres integer, parameter:: maxens3=16 @@ -46,9 +47,9 @@ module cu_unified_deep contains -!>\defgroup cu_unified_deep_group Unified Deep Convection Module -!>\ingroup cu_unified_group -!! This is Unified deep convection scheme module +!>\defgroup cu_c3_deep_group C3 Deep Convection Module +!>\ingroup cu_c3_group +!! This is C3 deep convection scheme module !> @{ integer function my_maxloc1d(A,N) !$acc routine vector @@ -72,8 +73,8 @@ integer function my_maxloc1d(A,N) end function my_maxloc1d !>Driver for the deep or congestus routine. -!! \section general_unified_deep Unified Deep Convection General Algorithm - subroutine cu_unified_deep_run( & +!! \section general_c3_deep C3 Deep Convection General Algorithm + subroutine cu_c3_deep_run( & itf,ktf,its,ite, kts,kte & ,flag_init & ,flag_restart & @@ -461,10 +462,7 @@ subroutine cu_unified_deep_run( & el2orc=xlv*xlv/(r_v*cp) evfact=0.25 ! .4 evfactl=0.25 ! .2 - !evfact=.0 ! for 4F5f - !evfactl=.4 -!cc rainevap(:)=0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -527,10 +525,7 @@ subroutine cu_unified_deep_run( & zws(i) = zws(i)*rho(i,kpbl(i)) !check if zrho is correct enddo !$acc end kernels -! cap_maxs=225. -! if(imid.eq.1)cap_maxs=150. cap_maxs=75. ! 150. -! if(imid.eq.1)cap_maxs=100. !$acc kernels do i=its,itf edto(i)=0. @@ -538,13 +533,10 @@ subroutine cu_unified_deep_run( & xmb_out(i)=0. cap_max(i)=cap_maxs cap_max_increment(i)=20. -! if(imid.eq.1)cap_max_increment(i)=10. ! ! for water or ice ! if (xland1(i)==0) then -! if(imid.eq.0)cap_max(i)=cap_maxs-25. -! if(imid.eq.1)cap_max(i)=cap_maxs-50. cap_max_increment(i)=20. else if(ztexec(i).gt.0.)cap_max(i)=cap_max(i)+25. @@ -553,7 +545,6 @@ subroutine cu_unified_deep_run( & #ifndef _OPENACC ierrc(i)=" " #endif -! cap_max_increment(i)=1. enddo !$acc end kernels if(use_excess == 0 )then @@ -588,8 +579,8 @@ subroutine cu_unified_deep_run( & c1d(i,:)= 0. !c1 ! 0. ! c1 ! max(.003,c1+float(csum(i))*.0001) entr_rate(i)=7.e-5 - min(20.,float(csum(i))) * 3.e-6 if(xland1(i) == 0)entr_rate(i)=7.e-5 + if(dx(i) frh_thresh)then @@ -598,7 +589,9 @@ subroutine cu_unified_deep_run( & entr_rate(i)=.2/radius endif sig(i)=(1.-frh)**2 - frh_out(i) = frh + !frh_out(i) = frh + if(forcing(i,7).eq.0.)sig(i)=1. + frh_out(i) = frh*sig(i) enddo !$acc end kernels sig_thresh = (1.-frh_thresh)**2 @@ -635,14 +628,15 @@ subroutine cu_unified_deep_run( & ! !$acc kernels edtmax(:)=1. - if(imid.eq.1)edtmax(:)=.15 +! if(imid.eq.1)edtmax(:)=.15 edtmin(:)=.1 - if(imid.eq.1)edtmin(:)=.05 +! if(imid.eq.1)edtmin(:)=.05 !$acc end kernels ! !--- minimum depth (m), clouds must have ! depth_min=3000. + if(dx(its) - Compute downdraft moist static energy + moisture budget do k=2,jmin(i)+1 @@ -1454,7 +1309,6 @@ subroutine cu_unified_deep_run( & dbydo(i,ki)=hcdo(i,ki)-heso_cup(i,ki) bud(i)=bud(i)+dbydo(i,ki)*dzo enddo - ! endif if(bud(i).gt.0)then ierr(i)=7 @@ -1470,29 +1324,10 @@ subroutine cu_unified_deep_run( & ! call cup_dd_moisture(ierrc,zdo,hcdo,heso_cup,qcdo,qeso_cup, & pwdo,qo_cup,zo_cup,dd_massentro,dd_massdetro,jmin,ierr,gammao_cup, & - pwevo,bu,qrcdo,qo,heo,1, & + pwevo,bu,qrcdo,po_cup,qo,heo,1, & itf,ktf, & its,ite, kts,kte) ! -!---meltglac------------------------------------------------- -!--- calculate moisture properties of updraft -! -! if(imid.eq.1)then -! call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & -! p_cup,kbcon,ktop,dbyo,clw_all,xland1, & -! qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & -! zqexec,ccn,rho,c1d,tn_cup,up_massentr,up_massdetr,psum,psumh, & -! 1,itf,ktf, & -! its,ite, kts,kte) -! else -! call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, & -! p_cup,kbcon,ktop,dbyo,clw_all,xland1, & -! qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & -! zqexec,ccn,rho,c1d,tn_cup,up_massentr,up_massdetr,psum,psumh, & -! 1,itf,ktf, & -! its,ite, kts,kte) -! endif -!---meltglac------------------------------------------------- !$acc kernels do i=its,itf if(ierr(i)/=0)cycle @@ -1517,7 +1352,7 @@ subroutine cu_unified_deep_run( & !> - Call cup_up_aa0() to calculate workfunctions for updrafts - + call cup_up_aa0(aa0,z,zu,dby,gamma_cup,t_cup, & kbcon,ktop,ierr, & itf,ktf, & @@ -1537,7 +1372,6 @@ subroutine cu_unified_deep_run( & #endif endif enddo - !$acc end kernels @@ -1555,8 +1389,8 @@ subroutine cu_unified_deep_run( & tau_ecmwf (:) = 0. !$acc end kernels !- way to calculate the fraction of cape consumed by shallow convection - iversion=1 ! ecmwf - !iversion=0 ! orig + !iversion=1 ! ecmwf + iversion=0 ! orig ! ! betchold et al 2008 time-scale of cape removal ! @@ -1596,6 +1430,29 @@ subroutine cu_unified_deep_run( & endif enddo !$acc end kernels +!$acc kernels + !-get the profiles modified only by bl tendencies + do i=its,itf + tn_bl(i,:)=0.;qo_bl(i,:)=0. + if ( ierr(i) == 0 )then + !below kbcon -> modify profiles + tn_bl(i,1:kbcon(i)) = tn(i,1:kbcon(i)) + qo_bl(i,1:kbcon(i)) = qo(i,1:kbcon(i)) + !above kbcon -> keep environment profiles + tn_bl(i,kbcon(i)+1:ktf) = t(i,kbcon(i)+1:ktf) + qo_bl(i,kbcon(i)+1:ktf) = q(i,kbcon(i)+1:ktf) + endif + enddo +!$acc end kernels + !> - Call cup_env() to calculate moist static energy, heights, qes, ... only by bl tendencies + call cup_env(zo,qeso_bl,heo_bl,heso_bl,tn_bl,qo_bl,po,z1, & + psur,ierr,tcrit,-1, & + itf,ktf, its,ite, kts,kte) + !> - Call cup_env_clev() to calculate environmental values on cloud levels only by bl tendencies + call cup_env_clev(tn_bl,qeso_bl,qo_bl,heo_bl,heso_bl,zo,po,qeso_cup_bl,qo_cup_bl, & + heo_cup_bl,heso_cup_bl,zo_cup,po_cup,gammao_cup_bl,tn_cup_bl,psur,& + ierr,z1, & + itf,ktf,its,ite, kts,kte) if(iversion == 1) then !-- version ecmwf @@ -1628,29 +1485,6 @@ subroutine cu_unified_deep_run( & !- version for real cloud-work function -!$acc kernels - !-get the profiles modified only by bl tendencies - do i=its,itf - tn_bl(i,:)=0.;qo_bl(i,:)=0. - if ( ierr(i) == 0 )then - !below kbcon -> modify profiles - tn_bl(i,1:kbcon(i)) = tn(i,1:kbcon(i)) - qo_bl(i,1:kbcon(i)) = qo(i,1:kbcon(i)) - !above kbcon -> keep environment profiles - tn_bl(i,kbcon(i)+1:ktf) = t(i,kbcon(i)+1:ktf) - qo_bl(i,kbcon(i)+1:ktf) = q(i,kbcon(i)+1:ktf) - endif - enddo -!$acc end kernels - !> - Call cup_env() to calculate moist static energy, heights, qes, ... only by bl tendencies - call cup_env(zo,qeso_bl,heo_bl,heso_bl,tn_bl,qo_bl,po,z1, & - psur,ierr,tcrit,-1, & - itf,ktf, its,ite, kts,kte) - !> - Call cup_env_clev() to calculate environmental values on cloud levels only by bl tendencies - call cup_env_clev(tn_bl,qeso_bl,qo_bl,heo_bl,heso_bl,zo,po,qeso_cup_bl,qo_cup_bl, & - heo_cup_bl,heso_cup_bl,zo_cup,po_cup,gammao_cup_bl,tn_cup_bl,psur, & - ierr,z1, & - itf,ktf,its,ite, kts,kte) !$acc kernels do i=its,itf if(ierr(i).eq.0)then @@ -1689,7 +1523,6 @@ subroutine cu_unified_deep_run( & enddo endif enddo - !$acc end kernels !> - Call cup_ip_aa0() to calculate workfunctions for updrafts call cup_up_aa0(aa1_bl,zo,zuo,dbyo_bl,gammao_cup_bl,tn_cup_bl, & @@ -1709,7 +1542,7 @@ subroutine cu_unified_deep_run( & aa1_bl(i) = aa1_bl(i)* tau_bl(i)/ dtime !endif #ifndef _OPENACC - print*,'aa0,aa1bl=',aa0(i),aa1_bl(i),aa0(i)-aa1_bl(i),tau_bl(i)!,dtime,xland(i) +! print*,'aa0,aa1bl=',aa0(i),aa1_bl(i),aa0(i)-aa1_bl(i),tau_bl(i)!,dtime,xland(i) #endif endif enddo @@ -1724,9 +1557,9 @@ subroutine cu_unified_deep_run( & ! !> - Call cup_dd_edt() to determine downdraft strength in terms of windshear ! - call cup_dd_edt(ierr,us,vs,zo,ktop,kbcon,edt,po,pwavo, & - pwo,ccn,ccnclean,pwevo,edtmax,edtmin,edtc,psum,psumh, & - rho,aeroevap,pefc,itf,ktf, & + call cup_dd_edt(ierr,us,vs,zo,ktop,kbcon,edt,po,pwavo, & + pwo,ccn,ccnclean,pwevo,edtmax,edtmin,edtc,psum,psumh, & + rho,aeroevap,pefc,xland1,itf,ktf, & its,ite, kts,kte) do i=its,itf if(ierr(i)/=0)cycle @@ -1735,8 +1568,8 @@ subroutine cu_unified_deep_run( & !> - Call get_melting_profile() to get melting profile call get_melting_profile(ierr,tn_cup,po_cup, p_liq_ice,melting_layer,qrco & - ,pwo,edto,pwdo,melting & - ,itf,ktf,its,ite, kts,kte, cumulus ) + ,pwo,edto,pwdo,melting & + ,itf,ktf,its,ite,kts,kte,cumulus) !$acc kernels do k=kts,ktf do i=its,itf @@ -1912,16 +1745,12 @@ subroutine cu_unified_deep_run( & !-- take out cloud liquid water for detrainment detup=up_massdetro(i,k) dz=zo_cup(i,k)-zo_cup(i,k-1) -!! if(k.lt.ktop(i) .and. k.ge.jmin(i)) then -!! if(k.lt.ktop(i) .and. c1d(i,k).gt.0) then if(k.lt.ktop(i)) then dellaqc(i,k) = zuo(i,k)*c1d(i,k)*qrco(i,k)*dz/dp*g else dellaqc(i,k)= detup*0.5*(qrco(i,k+1)+qrco(i,k)) *g/dp endif -!! if(imid.eq.1) dellaqc(i,k)= detup*0.5*(qrco(i,k+1)+qrco(i,k)) *g/dp -! if(k.eq.ktop(i))dellaqc(i,k)= detup*0.5*(qrco(i,k+1)+qrco(i,k)) *g/dp -! !--- + !--- g_rain= 0.5*(pwo (i,k)+pwo (i,k+1))*g/dp e_dn = -0.5*(pwdo(i,k)+pwdo(i,k+1))*g/dp*edto(i) ! pwdo < 0 and e_dn must > 0 !-- condensation source term = detrained + flux divergence of @@ -2230,6 +2059,8 @@ subroutine cu_unified_deep_run( & xff_mid(i,1)=min(0.1,xff_mid(i,1)) endif xff_mid(i,2)=min(0.1,.03*zws(i)) + forcing(i,1)=xff_mid(i,1) + forcing(i,2)=xff_mid(i,2) endif enddo !$acc end kernels @@ -2255,6 +2086,7 @@ subroutine cu_unified_deep_run( & !$acc kernels do i=its,itf if(ierr(i).eq.0 .and.pre(i).gt.0.) then + forcing(i,6)=sig(i) pre(i)=max(pre(i),0.) xmb_out(i)=xmb(i) outu(i,1)=dellu(i,1)*xmb(i) @@ -2385,7 +2217,7 @@ subroutine cu_unified_deep_run( & !---------------------------done------------------------------ ! - end subroutine cu_unified_deep_run + end subroutine cu_c3_deep_run !> Calculates tracer fluxes due to subsidence, only up-stream differencing @@ -2665,9 +2497,9 @@ end subroutine rain_evap_below_cloudbase !> Calculates strength of downdraft based on windshear and/or !! aerosol content. - subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & - pw,ccn,ccnclean,pwev,edtmax,edtmin,edtc,psum2,psumh, & - rho,aeroevap,pefc,itf,ktf, & + subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & + pw,ccn,ccnclean,pwev,edtmax,edtmin,edtc,psum2,psumh, & + rho,aeroevap,pefc,xland1,itf,ktf, & its,ite, kts,kte ) implicit none @@ -2696,7 +2528,7 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & pwav,pwev,psum2,psumh,edtmax,edtmin integer, dimension (its:ite) & ,intent (in ) :: & - ktop,kbcon + ktop,kbcon,xland1 real(kind=kind_phys), intent (in ) :: & !HCB ccnclean real(kind=kind_phys), dimension (its:ite) & @@ -2777,30 +2609,30 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & edt(i)=1.-.5*(pefb+pef) if(aeroevap.gt.1)then + pefb=.5 + if(xland1(i) == 1)pefb=.3 aeroadd=0. if((psumh(i)>0.).and.(psum2(i)>0.))then - aeroadd=((1.e-2*ccnclean)**beta3)*(psumh(i)**(alpha3-1)) - prop_c=.5*(pefb+pef)/aeroadd - aeroadd=((1.e-2*ccn(i))**beta3)*(psum2(i)**(alpha3-1)) + aeroadd=((ccnclean)**beta3)*(psumh(i)**(alpha3-1)) + prop_c=pefb/aeroadd + aeroadd=((ccn(i))**beta3)*(psum2(i)**(alpha3-1)) aeroadd=prop_c*aeroadd pefc(i)=aeroadd if(pefc(i).gt.0.9)pefc(i)=0.9 if(pefc(i).lt.0.1)pefc(i)=0.1 edt(i)=1.-pefc(i) - if(aeroevap.eq.2)edt(i)=1.-.25*(pefb+pef+2.*pefc(i)) endif endif !--- edt here is 1-precipeff! - einc=.2*edt(i) - edtc(i,1)=edt(i)-einc + edtc(i,1)=edt(i) endif enddo do i=its,itf if(ierr(i).eq.0)then - edtc(i,1)=-edtc(i,1)*pwav(i)/pwev(i) + edtc(i,1)=-edtc(i,1)*psum2(i)/pwev(i) if(edtc(i,1).gt.edtmax(i))edtc(i,1)=edtmax(i) if(edtc(i,1).lt.edtmin(i))edtc(i,1)=edtmin(i) endif @@ -2812,7 +2644,7 @@ end subroutine cup_dd_edt !> Calcultes moisture properties of downdrafts. subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & pwd,q_cup,z_cup,dd_massentr,dd_massdetr,jmin,ierr, & - gamma_cup,pwev,bu,qrcd, & + gamma_cup,pwev,bu,qrcd,p_cup, & q,he,iloop, & itf,ktf, & its,ite, kts,kte ) @@ -2842,7 +2674,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & zd,hes_cup,hcd,qes_cup,q_cup,z_cup, & - dd_massentr,dd_massdetr,gamma_cup,q,he + dd_massentr,dd_massdetr,gamma_cup,q,he,p_cup !$acc declare copyin(zd,hes_cup,hcd,qes_cup,q_cup,z_cup,dd_massentr,dd_massdetr,gamma_cup,q,he) integer & ,intent (in ) :: & @@ -2870,7 +2702,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & integer :: & i,k,ki real(kind=kind_phys) :: & - denom,dh,dz,dqeva + denom,dp,dh,dz,dqeva !$acc kernels do i=its,itf @@ -2891,6 +2723,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & if(ierr(i).eq.0)then k=jmin(i) dz=z_cup(i,k+1)-z_cup(i,k) + dp=-100.*(p_cup(i,k+1)-p_cup(i,k)) qcd(i,k)=q_cup(i,k) dh=hcd(i,k)-hes_cup(i,k) if(dh.lt.0)then @@ -2901,12 +2734,13 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & endif pwd(i,jmin(i))=zd(i,jmin(i))*min(0.,qcd(i,k)-qrcd(i,k)) qcd(i,k)=qrcd(i,k) - pwev(i)=pwev(i)+pwd(i,jmin(i)) ! *dz + pwev(i)=pwev(i)+pwd(i,jmin(i))*g/dp ! *dz ! bu(i)=dz*dh !$acc loop seq do ki=jmin(i)-1,1,-1 dz=z_cup(i,ki+1)-z_cup(i,ki) + dp=-100.*(p_cup(i,ki+1)-p_cup(i,ki)) ! qcd(i,ki)=(qcd(i,ki+1)*(1.-.5*cdd(i,ki+1)*dz) & ! +entr*dz*q(i,ki) & ! )/(1.+entr*dz-.5*cdd(i,ki+1)*dz) @@ -2939,10 +2773,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & endif pwd(i,ki)=zd(i,ki)*dqeva qcd(i,ki)=qrcd(i,ki) - pwev(i)=pwev(i)+pwd(i,ki) ! *dz -! if(iloop.eq.1.and.i.eq.102.and.j.eq.62)then -! print *,'in cup_dd_moi ', hcd(i,ki),hes_cup(i,ki),dh,dqeva -! endif + pwev(i)=pwev(i)+pwd(i,ki)*g/dp enddo ! !--- end loop over i @@ -3390,11 +3221,11 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xff_ens3(4)=betajb*xff_ens3(4) xff_ens3(5)=xff_ens3(4) xff_ens3(6)=xff_ens3(4) + forcing(i,2)=xff_ens3(4) if(xff_ens3(4).lt.0.)xff_ens3(4)=0. if(xff_ens3(5).lt.0.)xff_ens3(5)=0. if(xff_ens3(6).lt.0.)xff_ens3(6)=0. xff_ens3(14)=xff_ens3(4) - forcing(i,2)=xff_ens3(4) ! !--- more like krishnamurti et al.; pick max and average values ! @@ -3410,7 +3241,8 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xff_ens3(11)=aa1(i)/tau_ecmwf(i) xff_ens3(12)=aa1(i)/tau_ecmwf(i) xff_ens3(13)=(aa1(i))/tau_ecmwf(i) !(60.*15.) !tau_ecmwf(i) -! forcing(i,4)=xff_ens3(10) + forcing(i,4)=xff_ens3(10) +! forcing(i,5)= aa1_bl(i)/tau_ecmwf(i) !!- more like bechtold et al. (jas 2014) !! if(dicycle == 1) xff_dicycle = max(0.,aa1_bl(i)/tau_ecmwf(i)) !(60.*30.) !tau_ecmwf(i) @@ -3431,13 +3263,16 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 endif ! ichoice xk(1)=(xaa0(i,1)-aa1(i))/mbdt - forcing(i,4)=aa0(i) - forcing(i,5)=aa1(i) - forcing(i,6)=xaa0(i,1) - forcing(i,7)=xk(1) - if(xk(1).le.0.and.xk(1).gt.-.01*mbdt) & + forcing(i,8)=mbdt*xk(1)/aa1(i) +! if(forcing(i,1).lt.0. .or. forcing(i,8).gt.-4.)ierr(i)=333 +! if(forcing(i,2).lt.-0.05)ierr(i)=333 +! forcing(i,4)=aa0(i) +! forcing(i,5)=aa1(i) +! forcing(i,6)=xaa0(i,1) +! forcing(i,7)=xk(1) + if(xk(1).lt.0.and.xk(1).gt.-.01*mbdt) & xk(1)=-.01*mbdt - if(xk(1).gt.0.and.xk(1).lt.1.e-2) & + if(xk(1).ge.0.and.xk(1).lt.1.e-2) & xk(1)=1.e-2 ! enddo ! @@ -3528,13 +3363,13 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xf_ens(i,11)=xf_ens(i,11)+xf_ens(i,11)*rand_clos(i,4) xf_ens(i,12)=xf_ens(i,12)+xf_ens(i,12)*rand_clos(i,4) xf_ens(i,13)=xf_ens(i,13)+xf_ens(i,13)*rand_clos(i,4) - forcing(i,8)=xf_ens(i,11) +! forcing(i,8)=xf_ens(i,11) else xf_ens(i,10)=0. xf_ens(i,11)=0. xf_ens(i,12)=0. xf_ens(i,13)=0. - forcing(i,8)=0. + !forcing(i,8)=0. endif !srf-begin !! if(xk(1).lt.0.)then @@ -3586,13 +3421,16 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 if(ierr(i) /= 0)cycle xk(1)=(xaa0(i,1)-aa1(i))/mbdt - if(xk(1).le.0.and.xk(1).gt.-.01*mbdt) xk(1)=-.01*mbdt - if(xk(1).gt.0.and.xk(1).lt.1.e-2) xk(1)=1.e-2 - +! forcing(i,8)=xk(1) + if(xk(1).lt.0.and.xk(1).gt.-.01*mbdt) xk(1)=-.01*mbdt + if(xk(1).ge.0.and.xk(1).lt.1.e-2) xk(1)=1.e-2 + xff_dicycle = (aa1(i)-aa1_bl(i))/tau_ecmwf(i) +! forcing(i,8)=xff_dicycle if(xk(1).lt.0) xf_dicycle(i)= max(0.,-xff_dicycle/xk(1)) - + xf_dicycle(i)= xf_ens(i,10)-xf_dicycle(i) +! forcing(i,6)=xf_dicycle(i) enddo !$acc end kernels else @@ -4266,7 +4104,7 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc, & ! --- now use proper count of how many closures were actually ! used in cup_forcing_ens (including screening of some ! closures over water) to properly normalize xmb - clos_wei=16./max(1.,closure_n(i)) + clos_wei=16./max(1.,closure_n(i)) xmb_ave(i)=min(xmb_ave(i),100.) xmb(i)=clos_wei*sig(i)*xmb_ave(i) @@ -4473,13 +4311,15 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & iprop,iall,i,k integer :: start_level(its:ite),kklev(its:ite) !$acc declare create(start_level,kklev) - real(kind=kind_phys) :: & - prop_ave,qrcb_h,bdsp,dp,rhoc,qrch,qaver,clwdet, & + real(kind=kind_phys) :: & + prop_ave,qrcb_h,dp,rhoc,qrch,qaver,clwdet, & dz,berryc0,q1,berryc - real(kind=kind_phys) :: & + real(kind=kind_phys) :: & denom, c0t, c0_iceconv - real(kind=kind_phys), dimension (kts:kte) :: & + real(kind=kind_phys), dimension (kts:kte) :: & prop_b + real(kind=kind_phys), dimension (its:ite) :: & + bdsp !$acc declare create(prop_b) ! real(kind=kind_phys), parameter:: zero = 0 @@ -4495,7 +4335,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & clwdet=0.1 !0.02 c0_iceconv=0.01 c1d_b=c1d - bdsp=bdispm + bdsp(:)=bdispm ! !--- no precip for small clouds @@ -4509,6 +4349,11 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & pwavh(i)=0. psum(i)=0. psumh(i)=0. + if (xland1(i) .eq. 0) then + bdsp(i)=bdispm + else + bdsp(i)=bdispc + endif enddo do k=kts,ktf do i=its,itf @@ -4575,6 +4420,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qc(i,k)=qrch+qrc(i,k) clw_all(i,k)=qrc(i,k) endif + clw_allh(i,k)=clw_all(i,k) + qrcb(i,k)=qrc(i,k) + pwh(i,k)=pw(i,k) + qch(i,k)=qc(i,k) enddo ! endif ! @@ -4590,6 +4439,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & endif if(is_mid)c0t=0.004 + if(autoconv .gt.1) c0t=c0(i) denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) if(denom.lt.1.e-16)then ierr(i)=51 @@ -4599,7 +4449,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & rhoc=.5*(rho(i,k)+rho(i,k-1)) dz=z_cup(i,k)-z_cup(i,k-1) - dp=p_cup(i,k)-p_cup(i,k-1) + dp=-100.*(p_cup(i,k)-p_cup(i,k-1)) ! !--- saturation in cloud, this is what is allowed to be in it ! @@ -4632,10 +4482,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qrcb(i,k)=max(0.,(qch(i,k)-qrch)) ! /(1.+c0(i)*dz*zu(i,k)) if(is_deep)then clwdet=0.1 !0.02 ! 05/11/2021 - if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 + !if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 else clwdet=0.1 !0.02 ! 05/05/2021 - if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021 + !if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021 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) @@ -4648,50 +4498,52 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! this will also determine proportionality constant prop_b, which, if applied, ! would give the same results as c0 under these conditions ! - q1=1.e3*rhoc*clw_allh(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccnclean/ & - ( q1 * bdsp) ) ) !/( +! Berry conversion for clean atmosphere +! + q1=1.e3*rhoc*clw_allh(i,k) +! pwh units are kg/kg, but normalized by mass flux. So with massflux kg/m^2/s + pwh(i,k)=c0t*dz*zu(i,k)*clw_allh(i,k) qrcb_h=(qch(i,k)-qrch)/(1.+(c1d_b(i,k)+c0t)*dz) - prop_b(k)=(c0t*qrcb_h)/max(1.e-8,(1.e-3*berryc0)) - if(prop_b(k)>5.) prop_b(k)=5. - pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) ! 2. - qrcb(i,k)=(max(0.,(qch(i,k)-qrch))*zu(i,k)-pwh(i,k))/(zu(i,k)*(1+c1d_b(i,k)*dz)) - if(qrcb(i,k).lt.0.)then - berryc0=max(0.,(qch(i,k)-qrch))/(1.e-3*dz*prop_b(k)) - pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) - qrcb(i,k)=0. + qrcb(i,k)=0. +! unit (B) = g/m^3/s + berryc0=(q1*q1/(60.0*(5.0 + 0.0366*ccnclean*1.e1/ & + ( q1 * bdsp(i)) ) )) +! normalize Berry: berryc0=berryc0*g/dp*dz*zu = pwh, unts become kg/kg +! set 1: + berryc0=1.e-3*berryc0*g/dp*dz + prop_b(k)=pwh(i,k)/berryc0 + qrcb(i,k)=qrcb_h + if(qrcb(i,k).le.0.)then + pwh(i,k)=0. endif qch(i,k)=qrcb(i,k)+qrch pwavh(i)=pwavh(i)+pwh(i,k) - psumh(i)=psumh(i)+pwh(i,k) ! HCB - !psumh(i)=psumh(i)+clw_allh(i,k)*zu(i,k) *dz - ! + psumh(i)=psumh(i)+pwh(i,k)*g/dp !dz !dp/g !*dp ! HCB ! then the real berry ! - q1=1.e3*rhoc*clw_all(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccn(i)/ & - ( q1 * bdsp) ) ) !/( - berryc0=1.e-3*berryc0*dz*prop_b(k) ! 2. - qrc(i,k)=(max(0.,(qc(i,k)-qrch))*zu(i,k)-zu(i,k)*berryc0)/(zu(i,k)*(1+c1d(i,k)*dz)) + q1=1.e3*rhoc*clw_all(i,k) + berryc=(q1*q1/(60.0*(5.0 + 0.0366*ccn(i)*1.e1/ & + ( q1 * bdsp(i)) ) )) + berryc=1.e-3*berryc*g/dp*dz + pw(i,k)=prop_b(k)*berryc !*dz/zu(i,k) +! use berryc now as new c0 for this level + berryc=pw(i,k)/(dz*zu(i,k)*clw_all(i,k)) + if(qrc(i,k).le.0.)then + berryc=0. + endif + qrc(i,k)=(max(0.,(qc(i,k)-qrch))/(1+(c1d(i,k)+berryc)*dz)) if(qrc(i,k).lt.0.)then - berryc0=max(0.,(qc(i,k)-qrch))/(1.e-3*dz*prop_b(k)) qrc(i,k)=0. + pw(i,k)=0. endif - pw(i,k)=berryc0*zu(i,k) qc(i,k)=qrc(i,k)+qrch ! if not running with berry at all, do the following ! - else !c0=.002 - if(iall.eq.1)then - qrc(i,k)=0. - pw(i,k)=(qc(i,k)-qrch)*zu(i,k) - if(pw(i,k).lt.0.)pw(i,k)=0. - else + else ! create clw detrainment profile that depends on mass detrainment and ! in-cloud clw/ice ! - !c1d(i,k)=clwdet*up_massdetr(i,k-1)*qrc(i,k-1) qrc(i,k)=(qc(i,k)-qrch)/(1.+(c1d(i,k)+c0t)*dz) if(qrc(i,k).lt.0.)then ! hli new test 02/12/19 qrc(i,k)=0. @@ -4705,11 +4557,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qrc(i,k)=0. pw(i,k)=0. endif - endif - qc(i,k)=qrc(i,k)+qrch - endif !autoconv + qc(i,k)=qrc(i,k)+qrch + endif !autoconv pwav(i)=pwav(i)+pw(i,k) - psum(i)=psum(i)+pw(i,k) ! HCB + psum(i)=psum(i)+pw(i,k)*g/dp ! HCB enddo ! k=kbcon,ktop ! do not include liquid/ice in qc !$acc loop independent @@ -4885,9 +4736,6 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo ierr(i)=41 ktop(i)= 0 else -! call get_zu_zd_pdf_fim(ipr,xland(i),zuh2,"up",ierr(i),start_level(i), & -! call get_zu_zd_pdf_fim(rand_vmas(i),zubeg,ipr,xland(i),zuh2,"up",ierr(i),kbcon(i), & -! kfinalzu,zuo(i,kts:kte),kts,kte,ktf,beta_u,kpbl(i),csum(i),pmin_lev(i)) call get_zu_zd_pdf_fim(kklev,p_cup(i,:),rand_vmas(i),zubeg,ipr,xland(i),zuh2,1,ierr(i),k22(i), & kfinalzu+1,zuo(i,kts:kte),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) endif @@ -5365,7 +5213,7 @@ subroutine get_inversion_layers(ierr,p_cup,t_cup,z_cup,qo_cup,qeso_cup,k_inv_lay end subroutine get_inversion_layers !----------------------------------------------------------------------------------- ! DH* 20220604 - this isn't used at all -!!!!>\ingroup cu_unified_deep_group +!!!!>\ingroup cu_c3_deep_group !!!!> This function calcualtes !!! function deriv3(xx, xi, yi, ni, m) !!!!$acc routine vector @@ -6049,4 +5897,4 @@ end subroutine calculate_updraft_velocity !------------------------------------------------------------------------------------ !> @} -end module cu_unified_deep +end module cu_c3_deep diff --git a/physics/cu_unified_driver.F90 b/physics/cu_c3_driver.F90 similarity index 91% rename from physics/cu_unified_driver.F90 rename to physics/cu_c3_driver.F90 index 0e76af979..fd4d37b0b 100644 --- a/physics/cu_unified_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -1,41 +1,41 @@ -!>\file cu_unified_driver.F90 -!! This file is the unified cumulus scheme driver. +!>\file cu_c3_driver.F90 +!! This file is the Community Convective Cloud (C3) scheme driver. -module cu_unified_driver +module cu_c3_driver - ! DH* TODO: replace constants with arguments to cu_unified_driver_run + ! DH* TODO: replace constants with arguments to cu_c3_driver_run !use physcons , g => con_g, cp => con_cp, xlv => con_hvap, r_v => con_rv use machine , only: kind_phys - use cu_unified_deep, only: cu_unified_deep_run,neg_check,fct1d3 - use cu_unified_sh , only: cu_unified_sh_run + use cu_c3_deep, only: cu_c3_deep_run,neg_check,fct1d3 + use cu_c3_sh , only: cu_c3_sh_run use progsigma , only: progsigma_calc implicit none private - public :: cu_unified_driver_init, cu_unified_driver_run, progsigma_calc + public :: cu_c3_driver_init, cu_c3_driver_run, progsigma_calc contains -!> \defgroup cu_unified_group Grell-Freitas Convection Module +!> \defgroup cu_c3_group Grell-Freitas Convection Module !! This is the Grell-Freitas scale and aerosol aware scheme. !>@{ -!>\defgroup cu_unified_driver Grell-Freitas Convection Driver Module -!> \ingroup cu_unified_group +!>\defgroup cu_c3_driver Grell-Freitas Convection Driver Module +!> \ingroup cu_c3_group !> This is Grell-Freitas cumulus scheme driver module. !! -!! \section arg_table_cu_unified_driver_init Argument Table -!! \htmlinclude cu_unified_driver_init.html +!! \section arg_table_cu_c3_driver_init Argument Table +!! \htmlinclude cu_c3_driver_init.html !! - subroutine cu_unified_driver_init(imfshalcnv, imfshalcnv_unified, imfdeepcnv, & - imfdeepcnv_unified,mpirank, mpiroot, errmsg, errflg) + subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & + imfdeepcnv_c3,mpirank, mpiroot, errmsg, errflg) implicit none - integer, intent(in) :: imfshalcnv, imfshalcnv_unified - integer, intent(in) :: imfdeepcnv, imfdeepcnv_unified + integer, intent(in) :: imfshalcnv, imfshalcnv_c3 + integer, intent(in) :: imfdeepcnv, imfdeepcnv_c3 integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -45,7 +45,7 @@ subroutine cu_unified_driver_init(imfshalcnv, imfshalcnv_unified, imfdeepcnv, & errmsg = '' errflg = 0 - end subroutine cu_unified_driver_init + end subroutine cu_c3_driver_init ! ! t2di is temp after advection, but before physics @@ -53,11 +53,11 @@ end subroutine cu_unified_driver_init !=================== !> This is the Grell-Freitas convection scheme driver module. -!! \section arg_table_cu_unified_driver_run Argument Table -!! \htmlinclude cu_unified_driver_run.html +!! \section arg_table_cu_c3_driver_run Argument Table +!! \htmlinclude cu_c3_driver_run.html !! -!>\section gen_unified_driver Grell-Freitas Cumulus Scheme Driver General Algorithm - subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& +!>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm + subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & qv_spechum,t,cld1d,us,vs,t2di,w,qv2di_spechum,p2di,psuri, & @@ -68,7 +68,8 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & - sigmaout,errmsg,errflg) + sigmaout,maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in, & + ichoice_s_in,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -76,12 +77,11 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: maxens2=1 integer, parameter :: maxens3=16 integer, parameter :: ensdim=16 - integer, parameter :: imid_gf=1 ! testgf2 turn on middle gf conv. + integer :: imid_gf=1 ! gf congest conv. integer, parameter :: ideep=1 - integer, parameter :: ichoice=0 ! 0 2 5 13 8 - !integer, parameter :: ichoicem=5 ! 0 2 5 13 - integer, parameter :: ichoicem=13 ! 0 2 5 13 - integer, parameter :: ichoice_s=3 ! 0 1 2 3 + integer :: ichoice=0 ! 0 2 5 13 8 + integer :: ichoicem=13 ! 0 2 5 13 + integer :: ichoice_s=3 ! 0 1 2 3 logical, intent(in) :: do_cap_suppress real(kind=kind_phys), parameter :: aodc0=0.14 @@ -93,7 +93,8 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte integer, intent(in ) :: im,km,ntracer - logical, intent(in ) :: flag_init, flag_restart + integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in + logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & do_ca,progsigma real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v @@ -127,7 +128,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland - real(kind=kind_phys), dimension (:), intent(in) :: pbl + real(kind=kind_phys), dimension (:), intent(in) :: pbl,maxMF !$acc declare copyout(hbot,htop,kcnv) !$acc declare copyin(xland,pbl) integer, dimension (im) :: tropics @@ -135,7 +136,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! ruc variable real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri,ca_deep real(kind=kind_phys), dimension (:,:), intent(out) :: ud_mf,dd_mf,dt_mf - real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,rainevap + real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,maxupmf,rainevap real(kind=kind_phys), dimension (:,:), intent(in) :: t2di,p2di !$acc declare copyin(hfx2,qfx2,psuri,t2di,p2di) !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) @@ -234,7 +235,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! gf needs them in w/m2. define hfx and qfx after simple unit conversion real(kind=kind_phys), dimension (im) :: hfx,qfx !$acc declare create(hfx,qfx) - real(kind=kind_phys) tem,tem1,tf,tcr,tcrf + real(kind=kind_phys) tem,tem1,tf,tcr,tcrf,psum real(kind=kind_phys) :: cliw_shal,clcw_shal,tem_shal, cliw_both, weight_sum real(kind=kind_phys) :: cliw_deep,clcw_deep,tem_deep, clcw_both integer :: cliw_deep_idx, clcw_deep_idx, cliw_shal_idx, clcw_shal_idx @@ -252,6 +253,10 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& errmsg = '' errflg = 0 + ichoice = ichoice_in + ichoicem = ichoicem_in + ichoice_s = ichoice_s_in + if(do_cap_suppress) then !$acc serial do itime=1,num_dfi_radar @@ -343,10 +348,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& edtd(:)=0. zdd(:,:)=0. flux_tun(:)=5. -! 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. ! dx for scale awareness -! dx=40075000./float(lonf) -! tscl_kf=dx/25000. !$acc end kernels if (imfshalcnv == 5) then @@ -550,6 +552,9 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& subm(:,:)=0. dhdt(:,:)=0. + frhm(:)=0. + frhd(:)=0. + do k=kts,ktf do i=its,itf p2d(i,k)=0.01*p2di(i,k) @@ -614,17 +619,34 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& endif enddo enddo + do i = its,itf + psum=0. + do k=kts,ktf-3 + if (clcw(i,k) .gt. -999.0 .and. clcw(i,k+1) .gt. -999.0 )then + dp=(p2d(i,k)-p2d(i,k+1)) + psum=psum+dp + clwtot = cliw(i,k) + clcw(i,k) + if(clwtot.lt.1.e-32)clwtot=0. + forcing(i,7)=forcing(i,7)+clwtot*dp + endif + enddo + if(psum.gt.0)forcing(i,7)=forcing(i,7)/psum + forcing2(i,7)=forcing(i,7) + enddo do k=kts,ktf-1 do i = its,itf omeg(i,k)= w(i,k) !-g*rhoi(i,k)*w(i,k) -! dq=(q2d(i,k+1)-q2d(i,k)) -! mconv(i)=mconv(i)+omeg(i,k)*dq/g enddo enddo do i = its,itf if(mconv(i).lt.0.)mconv(i)=0. + if((dx(i)<6500.).and.do_mynnedmf.and.(maxMF(i).gt.0.))ierr(i)=555 enddo !$acc end kernels + if (dx(its)<6500.) then + ichoice=10 + imid_gf=0 + endif ! !---- call cumulus parameterization ! @@ -637,16 +659,16 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& enddo !$acc end kernels ! -!> - Call shallow: cu_unified_sh_run() +!> - Call shallow: cu_c3_sh_run() ! - call cu_unified_sh_run (us,vs, & + call cu_c3_sh_run (us,vs, & ! input variables, must be supplied zo,t2d,q2d,ter11,tshall,qshall,p2d,psur,dhdt,kpbli, & rhoi,hfx,qfx,xlandi,ichoice_s,tcrit,dt, & ! input variables. ierr should be initialized to zero or larger than zero for ! turning off shallow convection for grid points zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & -!Prog closure +! Prog closure flag_init, flag_restart,fv,r_d,delp,tmfq,qmicro, & forceqv_spechum,sigmain,sigmaout,progsigma,dx, & ! output tendencies @@ -656,7 +678,13 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc kernels do i=its,itf - if(xmbs(i).gt.0.)cutens(i)=1. + 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 !> - Call neg_check() for GF shallow convection @@ -666,9 +694,9 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ipr=0 jpr_deep=0 !340765 -!> - Call cu_unified_deep_run() for middle GF convection +!> - Call cu_c3_deep_run() for middle GF convection if(imid_gf == 1)then - call cu_unified_deep_run( & + call cu_c3_deep_run( & itf,ktf,its,ite, kts,kte & ,flag_init & ,flag_restart & @@ -685,7 +713,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,xlandi & ,delp & ,zo & - ,forcing2 & + ,forcing & ,t2d & ,q2d & ,tmfq & @@ -696,14 +724,14 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,ter11 & ,tshall & ,qshall & - ,p2d & + ,p2d & ,psur & ,us & ,vs & ,rhoi & ,hfx & ,qfx & - ,dx & !hj dx(im) + ,dx & ,do_ca & ,progsigma & ,ca_deep & @@ -757,9 +785,9 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& call neg_check('mid',ipn,dt,qcheck,outqm,outtm,outum,outvm, & outqcm,pretm,its,ite,kts,kte,itf,ktf,ktopm) endif -!> - Call cu_unified_deep_run() for deep GF convection +!> - Call cu_c3_deep_run() for deep GF convection if(ideep.eq.1)then - call cu_unified_deep_run( & + call cu_c3_deep_run( & itf,ktf,its,ite, kts,kte & ,flag_init & ,flag_restart & @@ -776,7 +804,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,xlandi & ,delp & ,zo & - ,forcing & + ,forcing2 & ,t2d & ,q2d & ,tmfq & @@ -794,7 +822,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,rhoi & ,hfx & ,qfx & - ,dx & !hj replace dx(im) + ,dx & ,do_ca & ,progsigma & ,ca_deep & @@ -852,25 +880,6 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& outqc,pret,its,ite,kts,kte,itf,ktf,ktop) ! endif -! do i=its,itf -! kcnv(i)=0 -! if(pret(i).gt.0.)then -! cuten(i)=1. -! kcnv(i)= 1 !jmin(i) -! else -! kbcon(i)=0 -! ktop(i)=0 -! cuten(i)=0. -! endif ! pret > 0 -! if(pretm(i).gt.0.)then -! kcnv(i)= 1 !jmin(i) -! cutenm(i)=1. -! else -! kbconm(i)=0 -! ktopm(i)=0 -! cutenm(i)=0. -! endif ! pret > 0 -! enddo !$acc kernels do i=its,itf kcnv(i)=0 @@ -917,6 +926,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& endif dtime_max=dt + forcing2(i,3)=0. do k=kts,kstop cnvc(i,k) = 0.04 * log(1. + 675. * zu(i,k) * xmb(i)) + & 0.04 * log(1. + 675. * zum(i,k) * xmbm(i)) + & @@ -934,8 +944,8 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod !gdc2(i,k,1)=max(0.,tun_rad_deep(i)*(cupclwm(i,k)*cutenm(i)+cupclw(i,k)*cuten(i))) - !gdc2(i,k,1)=max(0.,tun_rad_mid(i)*cupclwm(i,k)*cutenm(i)+tun_rad_deep(i)*cupclw(i,k)*cuten(i)+tun_rad_shall(i)*cupclws(i,k)*cutens(i)) - gdc2(i,k,1) = min(0.1, max(0.01, tun_rad_mid(i)*frhm(i)))*cupclwm(i,k)*cutenm(i) + min(0.1, max(0.01, tun_rad_deep(i)*(frhd(i))))*cupclw(i,k)*cuten(i) + tun_rad_shall(i)*cupclws(i,k)*cutens(i) + gdc2(i,k,1)=max(0.,tun_rad_mid(i)*cupclwm(i,k)*cutenm(i)+tun_rad_deep(i)*cupclw(i,k)*cuten(i)+tun_rad_shall(i)*cupclws(i,k)*cutens(i)) + !gdc2(i,k,1) = min(0.1, max(0.01, tun_rad_mid(i)*frhm(i)))*cupclwm(i,k)*cutenm(i) + min(0.1, max(0.01, tun_rad_deep(i)*(frhd(i))))*cupclw(i,k)*cuten(i) + tun_rad_shall(i)*cupclws(i,k)*cutens(i) qci_conv(i,k)=gdc2(i,k,1) gdc(i,k,2)=(outt(i,k))*86400. gdc(i,k,3)=(outtm(i,k))*86400. @@ -991,6 +1001,7 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& -(xmbm(i)*(zdm(i,k)-edtm(i)*zdm(i,k))) & -(xmbs(i)*zus(i,k)) trcflx_in1(k)=massflx(k)*.5*(clwtot+clwtot1) + forcing2(i,3)=forcing2(i,3)+clwtot endif enddo @@ -1028,6 +1039,12 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,13,10)=hfx(i) gdc(i,15,10)=qfx(i) 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)) + endif + if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) endif enddo @@ -1192,6 +1209,6 @@ subroutine cu_unified_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc end parallel endif endif - end subroutine cu_unified_driver_run + end subroutine cu_c3_driver_run !>@} -end module cu_unified_driver +end module cu_c3_driver diff --git a/physics/cu_unified_driver.meta b/physics/cu_c3_driver.meta similarity index 92% rename from physics/cu_unified_driver.meta rename to physics/cu_c3_driver.meta index 3a2e28c66..999b5c2bc 100644 --- a/physics/cu_unified_driver.meta +++ b/physics/cu_c3_driver.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = cu_unified_driver + name = cu_c3_driver type = scheme - dependencies = cu_unified_deep.F90,cu_unified_sh.F90,machine.F,physcons.F90,progsigma_calc.f90 + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,machine.F,physcons.F90,progsigma_calc.f90 ######################################################################## [ccpp-arg-table] - name = cu_unified_driver_init + name = cu_c3_driver_init type = scheme [imfshalcnv] standard_name = control_for_shallow_convection_scheme @@ -14,9 +14,9 @@ dimensions = () type = integer intent = in -[imfshalcnv_unified] - standard_name = identifier_for_unified_shallow_convection - long_name = flag for Unified shallow convection scheme +[imfshalcnv_c3] + standard_name = identifier_for_c3_shallow_convection + long_name = flag for C3 shallow convection scheme units = flag dimensions = () type = integer @@ -28,9 +28,9 @@ dimensions = () type = integer intent = in -[imfdeepcnv_unified] - standard_name = identifier_for_unified_deep_convection - long_name = flag for Unified deep convection scheme +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme units = flag dimensions = () type = integer @@ -67,7 +67,7 @@ ######################################################################## [ccpp-arg-table] - name = cu_unified_driver_run + name = cu_c3_driver_run type = scheme [ntracer] standard_name = number_of_tracers @@ -639,6 +639,50 @@ type = real kind = kind_phys intent = out +[maxupmf] + standard_name = maximum_convective_updraft_mass_flux + long_name = maximum convective updraft mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[maxMF] + standard_name = maximum_mass_flux + long_name = maximum mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[do_mynnedmf] + standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in +[ichoice_in] + standard_name = identifier_for_c3_or_gf_deep_convection_closure + long_name = flag for C3 or GF deep convection closure + units = flag + dimensions = () + type = integer + intent = in +[ichoicem_in] + standard_name = identifier_for_c3_or_gf_mid_convection_closure + long_name = flag for C3 or GF mid convection closure + units = flag + dimensions = () + type = integer + intent = in +[ichoice_s_in] + standard_name = identifier_for_c3_or_gf_shallow_convection_closure + long_name = flag for C3 or GF shallow convection closure + units = flag + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_c3_driver_post.F90 b/physics/cu_c3_driver_post.F90 new file mode 100644 index 000000000..74957a6b2 --- /dev/null +++ b/physics/cu_c3_driver_post.F90 @@ -0,0 +1,88 @@ +!> \file cu_c3_driver_post.F90 +!! Contains code related to C3 convective schemes to be used within the GFS physics suite. + +module cu_c3_driver_post + + implicit none + + private + + public :: cu_c3_driver_post_run + + contains + +!>\ingroup cu_c3_group +!> \section arg_table_cu_c3_driver_post_run Argument Table +!! \htmlinclude cu_c3_driver_post_run.html +!! + subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, dt, garea, raincv, maxupmf, refl_10cm, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in) :: im, km + real(kind_phys), intent(in) :: t(:,:) + real(kind_phys), intent(in) :: q(:,:) + real(kind_phys), dimension(:),intent(in) :: garea + real(kind_phys), intent(out) :: prevst(:,:) + real(kind_phys), intent(out) :: prevsq(:,:) + integer, intent(in) :: cactiv(:) + integer, intent(in) :: cactiv_m(:) + real(kind_phys), intent(out) :: conv_act(:) + real(kind_phys), intent(out) :: conv_act_m(:) + ! for Radar reflectivity + real(kind_phys), intent(in) :: dt + real(kind_phys), intent(in) :: raincv(:), maxupmf(:) + real(kind_phys), intent(inout) :: refl_10cm(:,:) + character(len=*), intent(out) :: errmsg +!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys), parameter :: dbzmin=-10.0 + real(kind_phys) :: cuprate + real(kind_phys) :: ze, ze_conv, dbz_sum + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +!$acc kernels + prevst(:,:) = t(:,:) + prevsq(:,:) = q(:,:) + + do i = 1, im + if (cactiv(i).gt.0) then + conv_act(i) = conv_act(i)+1.0 + else + conv_act(i)=0.0 + endif + if (cactiv_m(i).gt.0) then + conv_act_m(i) = conv_act_m(i)+1.0 + else + 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 + 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 + + end subroutine cu_c3_driver_post_run + +end module cu_c3_driver_post diff --git a/physics/cu_unified_driver_post.meta b/physics/cu_c3_driver_post.meta similarity index 66% rename from physics/cu_unified_driver_post.meta rename to physics/cu_c3_driver_post.meta index 5266b86e2..c53972f09 100644 --- a/physics/cu_unified_driver_post.meta +++ b/physics/cu_c3_driver_post.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = cu_unified_driver_post + name = cu_c3_driver_post type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = cu_unified_driver_post_run + name = cu_c3_driver_post_run type = scheme [im] standard_name = horizontal_loop_extent @@ -14,6 +14,13 @@ dimensions = () type = integer intent = in +[km] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in [t] standard_name = air_temperature_of_new_state long_name = temperature updated by physics @@ -76,6 +83,46 @@ type = real kind = kind_phys intent = out +[dt] + standard_name = timestep_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[garea] + standard_name = cell_area + long_name = grid cell area + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[raincv] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[maxupmf] + standard_name = maximum_convective_updraft_mass_flux + long_name = maximum convective updraft mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_unified_driver_pre.F90 b/physics/cu_c3_driver_pre.F90 similarity index 80% rename from physics/cu_unified_driver_pre.F90 rename to physics/cu_c3_driver_pre.F90 index 69d6d9be4..c6e79059b 100644 --- a/physics/cu_unified_driver_pre.F90 +++ b/physics/cu_c3_driver_pre.F90 @@ -1,21 +1,21 @@ -!> \file cu_unified_driver_pre.F90 -!! Contains code related to the unified convective schemes to be used within the GFS physics suite. +!> \file cu_c3_driver_pre.F90 +!! Contains code related to the C3 convective schemes to be used within the GFS physics suite. -module cu_unified_driver_pre +module cu_c3_driver_pre implicit none private - public :: cu_unified_driver_pre_run + public :: cu_c3_driver_pre_run contains -!>\ingroup cu_unified_group -!> \section arg_table_cu_unified_driver_pre_run Argument Table -!! \htmlinclude cu_unified_driver_pre_run.html +!>\ingroup cu_c3_group +!> \section arg_table_cu_c3_driver_pre_run Argument Table +!! \htmlinclude cu_c3_driver_pre_run.html !! - subroutine cu_unified_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & + subroutine cu_c3_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, & errmsg, errflg) @@ -79,6 +79,6 @@ subroutine cu_unified_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, cactiv_m(:)=nint(conv_act_m(:)) !$acc end kernels - end subroutine cu_unified_driver_pre_run + end subroutine cu_c3_driver_pre_run -end module cu_unified_driver_pre +end module cu_c3_driver_pre diff --git a/physics/cu_unified_driver_pre.meta b/physics/cu_c3_driver_pre.meta similarity index 98% rename from physics/cu_unified_driver_pre.meta rename to physics/cu_c3_driver_pre.meta index aa8b870db..c018bee9f 100644 --- a/physics/cu_unified_driver_pre.meta +++ b/physics/cu_c3_driver_pre.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = cu_unified_driver_pre + name = cu_c3_driver_pre type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = cu_unified_driver_pre_run + name = cu_c3_driver_pre_run type = scheme [flag_init] standard_name = flag_for_first_timestep diff --git a/physics/cu_unified_sh.F90 b/physics/cu_c3_sh.F90 similarity index 98% rename from physics/cu_unified_sh.F90 rename to physics/cu_c3_sh.F90 index 84e5cc6da..0ea0f28ae 100644 --- a/physics/cu_unified_sh.F90 +++ b/physics/cu_c3_sh.F90 @@ -1,7 +1,7 @@ -!>\file cu_unified_sh.F90 -!! This file contains unified shallow convection scheme. +!>\file cu_c3_sh.F90 +!! This file contains C3 shallow convection scheme. -module cu_unified_sh +module cu_c3_sh use machine , only : kind_phys use progsigma, only : progsigma_calc @@ -16,9 +16,9 @@ module cu_unified_sh contains -!>\defgroup cu_unified_sh_group Grell-Freitas Shallow Convection Module +!>\defgroup cu_c3_sh_group Grell-Freitas Shallow Convection Module !! This module contains Grell-Freitas shallow convection scheme. -!> \ingroup cu_unified_group +!> \ingroup cu_c3_group !> @{ !> GF shallow convection as described in Grell and !! Freitas (2014) \cite grell_and_freitas_2014. input variables are: @@ -62,8 +62,8 @@ module cu_unified_sh !!\param itf,ktf,its,ite, kts,kte are dimensions !!\param ipr horizontal index of printed column !!\param tropics =0 -!>\section gen_cu_unified_sh_run Grell-Freitas Shallow Convection General Algorithm - subroutine cu_unified_sh_run ( & +!>\section gen_cu_c3_sh_run Grell-Freitas Shallow Convection General Algorithm + subroutine cu_c3_sh_run ( & us,vs,zo,t,q,z1,tn,qo,po,psur,dhdt,kpbl,rho, & ! input variables, must be supplied hfx,qfx,xland,ichoice,tcrit,dtime, & zuo,xmb_out,kbcon,ktop,k22,ierr,ierrc, & @@ -74,7 +74,7 @@ subroutine cu_unified_sh_run ( & ! ! this module needs some subroutines from gf_deep ! - use cu_unified_deep,only:cup_env,cup_env_clev,get_cloud_bc,cup_minimi, & + use cu_c3_deep,only:cup_env,cup_env_clev,get_cloud_bc,cup_minimi, & get_inversion_layers,rates_up_pdf,get_cloud_bc, & cup_up_aa0,cup_kbcon,get_lateral_massflux, & calculate_updraft_velocity @@ -1116,6 +1116,6 @@ subroutine cu_unified_sh_run ( & ! print*,'hlisq',qco(1,k),qrco(1,k),pwo(1,k) ! enddo - end subroutine cu_unified_sh_run + end subroutine cu_c3_sh_run !> @} -end module cu_unified_sh +end module cu_c3_sh diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 2335a2308..67dd9bd3f 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -554,7 +554,6 @@ subroutine cu_gf_deep_run( & if(xland1(i) == 0)entr_rate(i)=7.e-5 if(dx(i) frh_thresh)then @@ -563,8 +562,9 @@ subroutine cu_gf_deep_run( & entr_rate(i)=.2/radius endif sig(i)=(1.-frh)**2 - frh_out(i) = frh - if((dx(i) Calculates strength of downdraft based on windshear and/or !! aerosol content. - subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & - pw,ccn,ccnclean,pwev,edtmax,edtmin,edtc,psum2,psumh, & - rho,aeroevap,pefc,itf,ktf, & + subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & + pw,ccn,ccnclean,pwev,edtmax,edtmin,edtc,psum2,psumh, & + rho,aeroevap,pefc,xland1,itf,ktf, & its,ite, kts,kte ) implicit none @@ -2455,7 +2453,7 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & pwav,pwev,psum2,psumh,edtmax,edtmin integer, dimension (its:ite) & ,intent (in ) :: & - ktop,kbcon + ktop,kbcon,xland1 real(kind=kind_phys), intent (in ) :: & !HCB ccnclean real(kind=kind_phys), dimension (its:ite) & @@ -2536,30 +2534,30 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & edt(i)=1.-.5*(pefb+pef) if(aeroevap.gt.1)then + pefb=.5 + if(xland1(i) == 1)pefb=.3 aeroadd=0. if((psumh(i)>0.).and.(psum2(i)>0.))then - aeroadd=((1.e-2*ccnclean)**beta3)*(psumh(i)**(alpha3-1)) - prop_c=.5*(pefb+pef)/aeroadd - aeroadd=((1.e-2*ccn(i))**beta3)*(psum2(i)**(alpha3-1)) + aeroadd=((ccnclean)**beta3)*(psumh(i)**(alpha3-1)) + prop_c=pefb/aeroadd + aeroadd=((ccn(i))**beta3)*(psum2(i)**(alpha3-1)) aeroadd=prop_c*aeroadd pefc(i)=aeroadd if(pefc(i).gt.0.9)pefc(i)=0.9 if(pefc(i).lt.0.1)pefc(i)=0.1 edt(i)=1.-pefc(i) - if(aeroevap.eq.2)edt(i)=1.-.25*(pefb+pef+2.*pefc(i)) endif endif !--- edt here is 1-precipeff! - einc=.2*edt(i) - edtc(i,1)=edt(i)-einc + edtc(i,1)=edt(i) endif enddo do i=its,itf if(ierr(i).eq.0)then - edtc(i,1)=-edtc(i,1)*pwav(i)/pwev(i) + edtc(i,1)=-edtc(i,1)*psum2(i)/pwev(i) if(edtc(i,1).gt.edtmax(i))edtc(i,1)=edtmax(i) if(edtc(i,1).lt.edtmin(i))edtc(i,1)=edtmin(i) endif @@ -2571,7 +2569,7 @@ end subroutine cup_dd_edt !> Calcultes moisture properties of downdrafts. subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & pwd,q_cup,z_cup,dd_massentr,dd_massdetr,jmin,ierr, & - gamma_cup,pwev,bu,qrcd, & + gamma_cup,pwev,bu,qrcd,p_cup, & q,he,iloop, & itf,ktf, & its,ite, kts,kte ) @@ -2601,7 +2599,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & zd,hes_cup,hcd,qes_cup,q_cup,z_cup, & - dd_massentr,dd_massdetr,gamma_cup,q,he + dd_massentr,dd_massdetr,gamma_cup,q,he,p_cup !$acc declare copyin(zd,hes_cup,hcd,qes_cup,q_cup,z_cup,dd_massentr,dd_massdetr,gamma_cup,q,he) integer & ,intent (in ) :: & @@ -2629,7 +2627,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & integer :: & i,k,ki real(kind=kind_phys) :: & - denom,dh,dz,dqeva + denom,dp,dh,dz,dqeva !$acc kernels do i=its,itf @@ -2650,6 +2648,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & if(ierr(i).eq.0)then k=jmin(i) dz=z_cup(i,k+1)-z_cup(i,k) + dp=-100.*(p_cup(i,k+1)-p_cup(i,k)) qcd(i,k)=q_cup(i,k) dh=hcd(i,k)-hes_cup(i,k) if(dh.lt.0)then @@ -2660,12 +2659,13 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & endif pwd(i,jmin(i))=zd(i,jmin(i))*min(0.,qcd(i,k)-qrcd(i,k)) qcd(i,k)=qrcd(i,k) - pwev(i)=pwev(i)+pwd(i,jmin(i)) ! *dz + pwev(i)=pwev(i)+pwd(i,jmin(i))*g/dp ! *dz ! bu(i)=dz*dh !$acc loop seq do ki=jmin(i)-1,1,-1 dz=z_cup(i,ki+1)-z_cup(i,ki) + dp=-100.*(p_cup(i,ki+1)-p_cup(i,ki)) ! qcd(i,ki)=(qcd(i,ki+1)*(1.-.5*cdd(i,ki+1)*dz) & ! +entr*dz*q(i,ki) & ! )/(1.+entr*dz-.5*cdd(i,ki+1)*dz) @@ -2698,10 +2698,7 @@ subroutine cup_dd_moisture(ierrc,zd,hcd,hes_cup,qcd,qes_cup, & endif pwd(i,ki)=zd(i,ki)*dqeva qcd(i,ki)=qrcd(i,ki) - pwev(i)=pwev(i)+pwd(i,ki) ! *dz -! if(iloop.eq.1.and.i.eq.102.and.j.eq.62)then -! print *,'in cup_dd_moi ', hcd(i,ki),hes_cup(i,ki),dh,dqeva -! endif + pwev(i)=pwev(i)+pwd(i,ki)*g/dp enddo ! !--- end loop over i @@ -3990,11 +3987,7 @@ subroutine cup_output_ens_3d(xff_mid,xf_ens,ierr,dellat,dellaq,dellaqc, & ! --- now use proper count of how many closures were actually ! used in cup_forcing_ens (including screening of some ! closures over water) to properly normalize xmb - if (dx(i).ge.dx_thresh)then - clos_wei=16./max(1.,closure_n(i)) - else - clos_wei=1. - endif + clos_wei=16./max(1.,closure_n(i)) xmb_ave(i)=min(xmb_ave(i),100.) xmb(i)=clos_wei*sig(i)*xmb_ave(i) @@ -4199,13 +4192,15 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & iprop,iall,i,k integer :: start_level(its:ite),kklev(its:ite) !$acc declare create(start_level,kklev) - real(kind=kind_phys) :: & - prop_ave,qrcb_h,bdsp,dp,rhoc,qrch,qaver,clwdet, & + real(kind=kind_phys) :: & + prop_ave,qrcb_h,dp,rhoc,qrch,qaver,clwdet, & dz,berryc0,q1,berryc - real(kind=kind_phys) :: & + real(kind=kind_phys) :: & denom, c0t, c0_iceconv - real(kind=kind_phys), dimension (kts:kte) :: & + real(kind=kind_phys), dimension (kts:kte) :: & prop_b + real(kind=kind_phys), dimension (its:ite) :: & + bdsp !$acc declare create(prop_b) ! real(kind=kind_phys), parameter:: zero = 0 @@ -4221,7 +4216,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & clwdet=0.1 !0.02 c0_iceconv=0.01 c1d_b=c1d - bdsp=bdispm + bdsp(:)=bdispm ! !--- no precip for small clouds @@ -4235,6 +4230,11 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & pwavh(i)=0. psum(i)=0. psumh(i)=0. + if (xland1(i) .eq. 0) then + bdsp(i)=bdispm + else + bdsp(i)=bdispc + endif enddo do k=kts,ktf do i=its,itf @@ -4301,6 +4301,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qc(i,k)=qrch+qrc(i,k) clw_all(i,k)=qrc(i,k) endif + clw_allh(i,k)=clw_all(i,k) + qrcb(i,k)=qrc(i,k) + pwh(i,k)=pw(i,k) + qch(i,k)=qc(i,k) enddo ! endif ! @@ -4316,6 +4320,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & endif if(is_mid)c0t=0.004 + if(autoconv .gt.1) c0t=c0(i) denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) if(denom.lt.1.e-16)then ierr(i)=51 @@ -4325,7 +4330,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & rhoc=.5*(rho(i,k)+rho(i,k-1)) dz=z_cup(i,k)-z_cup(i,k-1) - dp=p_cup(i,k)-p_cup(i,k-1) + dp=-100.*(p_cup(i,k)-p_cup(i,k-1)) ! !--- saturation in cloud, this is what is allowed to be in it ! @@ -4358,10 +4363,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qrcb(i,k)=max(0.,(qch(i,k)-qrch)) ! /(1.+c0(i)*dz*zu(i,k)) if(is_deep)then clwdet=0.1 !0.02 ! 05/11/2021 - if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 + !if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 else clwdet=0.1 !0.02 ! 05/05/2021 - if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021 + !if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021 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) @@ -4374,50 +4379,52 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! this will also determine proportionality constant prop_b, which, if applied, ! would give the same results as c0 under these conditions ! - q1=1.e3*rhoc*clw_allh(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccnclean/ & - ( q1 * bdsp) ) ) !/( +! Berry conversion for clean atmosphere +! + q1=1.e3*rhoc*clw_allh(i,k) +! pwh units are kg/kg, but normalized by mass flux. So with massflux kg/m^2/s + pwh(i,k)=c0t*dz*zu(i,k)*clw_allh(i,k) qrcb_h=(qch(i,k)-qrch)/(1.+(c1d_b(i,k)+c0t)*dz) - prop_b(k)=(c0t*qrcb_h)/max(1.e-8,(1.e-3*berryc0)) - if(prop_b(k)>5.) prop_b(k)=5. - pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) ! 2. - qrcb(i,k)=(max(0.,(qch(i,k)-qrch))*zu(i,k)-pwh(i,k))/(zu(i,k)*(1+c1d_b(i,k)*dz)) - if(qrcb(i,k).lt.0.)then - berryc0=max(0.,(qch(i,k)-qrch))/(1.e-3*dz*prop_b(k)) - pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) qrcb(i,k)=0. +! unit (B) = g/m^3/s + berryc0=(q1*q1/(60.0*(5.0 + 0.0366*ccnclean*1.e1/ & + ( q1 * bdsp(i)) ) )) +! normalize Berry: berryc0=berryc0*g/dp*dz*zu = pwh, unts become kg/kg +! set 1: + berryc0=1.e-3*berryc0*g/dp*dz + prop_b(k)=pwh(i,k)/berryc0 + qrcb(i,k)=qrcb_h + if(qrcb(i,k).le.0.)then + pwh(i,k)=0. endif qch(i,k)=qrcb(i,k)+qrch pwavh(i)=pwavh(i)+pwh(i,k) - psumh(i)=psumh(i)+pwh(i,k) ! HCB - !psumh(i)=psumh(i)+clw_allh(i,k)*zu(i,k) *dz - ! + psumh(i)=psumh(i)+pwh(i,k)*g/dp !dz !dp/g !*dp ! HCB ! then the real berry ! - q1=1.e3*rhoc*clw_all(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccn(i)/ & - ( q1 * bdsp) ) ) !/( - berryc0=1.e-3*berryc0*dz*prop_b(k) ! 2. - qrc(i,k)=(max(0.,(qc(i,k)-qrch))*zu(i,k)-zu(i,k)*berryc0)/(zu(i,k)*(1+c1d(i,k)*dz)) + q1=1.e3*rhoc*clw_all(i,k) + berryc=(q1*q1/(60.0*(5.0 + 0.0366*ccn(i)*1.e1/ & + ( q1 * bdsp(i)) ) )) + berryc=1.e-3*berryc*g/dp*dz + pw(i,k)=prop_b(k)*berryc !*dz/zu(i,k) +! use berryc now as new c0 for this level + berryc=pw(i,k)/(dz*zu(i,k)*clw_all(i,k)) + if(qrc(i,k).le.0.)then + berryc=0. + endif + qrc(i,k)=(max(0.,(qc(i,k)-qrch))/(1+(c1d(i,k)+berryc)*dz)) if(qrc(i,k).lt.0.)then - berryc0=max(0.,(qc(i,k)-qrch))/(1.e-3*dz*prop_b(k)) qrc(i,k)=0. + pw(i,k)=0. endif - pw(i,k)=berryc0*zu(i,k) qc(i,k)=qrc(i,k)+qrch ! if not running with berry at all, do the following ! - else !c0=.002 - if(iall.eq.1)then - qrc(i,k)=0. - pw(i,k)=(qc(i,k)-qrch)*zu(i,k) - if(pw(i,k).lt.0.)pw(i,k)=0. - else + else ! create clw detrainment profile that depends on mass detrainment and ! in-cloud clw/ice ! - !c1d(i,k)=clwdet*up_massdetr(i,k-1)*qrc(i,k-1) qrc(i,k)=(qc(i,k)-qrch)/(1.+(c1d(i,k)+c0t)*dz) if(qrc(i,k).lt.0.)then ! hli new test 02/12/19 qrc(i,k)=0. @@ -4431,11 +4438,10 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qrc(i,k)=0. pw(i,k)=0. endif - endif - qc(i,k)=qrc(i,k)+qrch - endif !autoconv + qc(i,k)=qrc(i,k)+qrch + endif !autoconv pwav(i)=pwav(i)+pw(i,k) - psum(i)=psum(i)+pw(i,k) ! HCB + psum(i)=psum(i)+pw(i,k)*g/dp ! HCB enddo ! k=kbcon,ktop ! do not include liquid/ice in qc !$acc loop independent @@ -4611,9 +4617,6 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo ierr(i)=41 ktop(i)= 0 else -! call get_zu_zd_pdf_fim(ipr,xland(i),zuh2,"up",ierr(i),start_level(i), & -! call get_zu_zd_pdf_fim(rand_vmas(i),zubeg,ipr,xland(i),zuh2,"up",ierr(i),kbcon(i), & -! kfinalzu,zuo(i,kts:kte),kts,kte,ktf,beta_u,kpbl(i),csum(i),pmin_lev(i)) call get_zu_zd_pdf_fim(kklev,p_cup(i,:),rand_vmas(i),zubeg,ipr,xland(i),zuh2,1,ierr(i),k22(i), & kfinalzu+1,zuo(i,kts:kte),kts,kte,ktf,beta_u,kbcon(i),csum(i),pmin_lev(i)) endif diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index ca9f0bec2..f82569b99 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -66,7 +66,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & - maxupmf,maxMF,errmsg,errflg) + maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & + errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -76,10 +77,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: ensdim=16 integer :: imid_gf=1 ! gf congest conv. integer, parameter :: ideep=1 - integer :: ichoice=0 ! 0 2 5 13 8 - !integer, parameter :: ichoicem=5 ! 0 2 5 13 - integer, parameter :: ichoicem=13 ! 0 2 5 13 - integer, parameter :: ichoice_s=3 ! 0 1 2 3 + integer :: ichoice=0 ! 0 2 5 13 8 + integer :: ichoicem=13 ! 0 2 5 13 + integer :: ichoice_s=3 ! 0 1 2 3 logical, intent(in) :: do_cap_suppress real(kind=kind_phys), parameter :: aodc0=0.14 @@ -91,7 +91,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte integer, intent(in ) :: im,km,ntracer - logical, intent(in ) :: flag_init, flag_restart + integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in + logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend real (kind=kind_phys), intent(in) :: g,cp,xlv,r_v logical, intent(in ) :: ldiag3d @@ -246,6 +247,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& errmsg = '' errflg = 0 + ichoice = ichoice_in + ichoicem = ichoicem_in + ichoice_s = ichoice_s_in if(do_cap_suppress) then !$acc serial do itime=1,num_dfi_radar @@ -337,10 +341,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& edtd(:)=0. zdd(:,:)=0. flux_tun(:)=5. -! 10/11/2016 dx and tscl_kf are replaced with input dx(i), is dlength. ! dx for scale awareness -! dx=40075000./float(lonf) -! tscl_kf=dx/25000. !$acc end kernels if (imfshalcnv == 3) then @@ -625,7 +626,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& enddo do i = its,itf if(mconv(i).lt.0.)mconv(i)=0. - if(maxMF(i).gt.0.)ierr(i)=555 + if((dx(i)<6500.).and.do_mynnedmf.and.(maxMF(i).gt.0.))ierr(i)=555 enddo !$acc end kernels if (dx(its)<6500.) then @@ -660,7 +661,13 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc kernels do i=its,itf - if(xmbs(i).gt.0.)cutens(i)=1. + 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 !> - Call neg_check() for GF shallow convection @@ -897,8 +904,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod !gdc2(i,k,1)=max(0.,tun_rad_deep(i)*(cupclwm(i,k)*cutenm(i)+cupclw(i,k)*cuten(i))) - !gdc2(i,k,1)=max(0.,tun_rad_mid(i)*cupclwm(i,k)*cutenm(i)+tun_rad_deep(i)*cupclw(i,k)*cuten(i)+tun_rad_shall(i)*cupclws(i,k)*cutens(i)) - gdc2(i,k,1) = min(0.1, max(0.01, tun_rad_mid(i)*frhm(i)))*cupclwm(i,k)*cutenm(i) + min(0.1, max(0.01, tun_rad_deep(i)*(frhd(i))))*cupclw(i,k)*cuten(i) + tun_rad_shall(i)*cupclws(i,k)*cutens(i) + gdc2(i,k,1)=max(0.,tun_rad_mid(i)*cupclwm(i,k)*cutenm(i)+frhd(i)*cupclw(i,k)*cuten(i)+tun_rad_shall(i)*cupclws(i,k)*cutens(i)) + !gdc2(i,k,1) = min(0.1, max(0.01, tun_rad_mid(i)*frhm(i)))*cupclwm(i,k)*cutenm(i) + min(0.1, max(0.01, tun_rad_deep(i)*(frhd(i))))*cupclw(i,k)*cuten(i) + tun_rad_shall(i)*cupclws(i,k)*cutens(i) qci_conv(i,k)=gdc2(i,k,1) gdc(i,k,2)=(outt(i,k))*86400. gdc(i,k,3)=(outtm(i,k))*86400. @@ -993,10 +1000,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& gdc(i,15,10)=qfx(i) 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)) - else - maxupmf(i)=0. endif if(ktop(i).gt.2 .and.pret(i).gt.0.)dt_mf(i,ktop(i)-1)=ud_mf(i,ktop(i)) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 60c7e7fe5..8b1a46e2d 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -569,6 +569,34 @@ type = real kind = kind_phys intent = in +[do_mynnedmf] + standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in +[ichoice_in] + standard_name = identifier_for_c3_or_gf_deep_convection_closure + long_name = flag for C3 or GF deep convection closure + units = flag + dimensions = () + type = integer + intent = in +[ichoicem_in] + standard_name = identifier_for_c3_or_gf_mid_convection_closure + long_name = flag for C3 or GF mid convection closure + units = flag + dimensions = () + type = integer + intent = in +[ichoice_s_in] + standard_name = identifier_for_c3_or_gf_shallow_convection_closure + long_name = flag for C3 or GF shallow convection closure + units = flag + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_unified_driver_post.F90 b/physics/cu_unified_driver_post.F90 deleted file mode 100644 index 821992bff..000000000 --- a/physics/cu_unified_driver_post.F90 +++ /dev/null @@ -1,65 +0,0 @@ -!> \file cu_unified_driver_post.F90 -!! Contains code related to unified convective schemes to be used within the GFS physics suite. - -module cu_unified_driver_post - - implicit none - - private - - public :: cu_unified_driver_post_run - - contains - -!>\ingroup cu_unified_group -!> \section arg_table_cu_unified_driver_post_run Argument Table -!! \htmlinclude cu_unified_driver_post_run.html -!! - subroutine cu_unified_driver_post_run (im, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in) :: im - real(kind_phys), intent(in) :: t(:,:) - real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), intent(out) :: prevst(:,:) - real(kind_phys), intent(out) :: prevsq(:,:) - integer, intent(in) :: cactiv(:) - integer, intent(in) :: cactiv_m(:) - real(kind_phys), intent(out) :: conv_act(:) - real(kind_phys), intent(out) :: conv_act_m(:) - character(len=*), intent(out) :: errmsg -!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) - integer, intent(out) :: errflg - - ! Local variables - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -!$acc kernels - prevst(:,:) = t(:,:) - prevsq(:,:) = q(:,:) - - do i = 1, im - if (cactiv(i).gt.0) then - conv_act(i) = conv_act(i)+1.0 - else - conv_act(i)=0.0 - endif - if (cactiv_m(i).gt.0) then - conv_act_m(i) = conv_act_m(i)+1.0 - else - conv_act_m(i)=0.0 - endif - enddo -!$acc end kernels - - end subroutine cu_unified_driver_post_run - -end module cu_unified_driver_post diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 079218f5a..111be4019 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -32,7 +32,7 @@ ! imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, ! ! iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, ! ! idcor_hogan, idcor_oreopoulos, ! -! imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_unified, do_mynnedmf, lgfdlmprad, ! +! imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf, lgfdlmprad, ! ! uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, ! ! effrl, effri, effrr, effrs, effr_in, ! ! effrl_inout, effri_inout, effrs_inout, ! @@ -347,7 +347,7 @@ subroutine radiation_clouds_prop & & 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_unified, & + & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, & & do_mynnedmf, lgfdlmprad, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & @@ -450,7 +450,7 @@ subroutine radiation_clouds_prop & ! idcor_oreopoulos: flag for decorrelation-length: (=2) ! ! imfdeepcnv : flag for mass-flux deep convection scheme ! ! imfdeepcnv_gf : flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) -! imfdeepcnv_unified : flag for unified convection scheme +! imfdeepcnv_c3 : flag for unified convection scheme ! do_mynnedmf : flag for MYNN-EDMF ! ! lgfdlmprad : flag for GFDLMP radiation interaction ! ! uni_cld : logical - true for cloud fraction from shoc ! @@ -511,7 +511,7 @@ subroutine radiation_clouds_prop & integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, & & ntclamt integer, intent(in) :: kdt, imfdeepcnv, imfdeepcnv_gf, & - & imfdeepcnv_unified + & imfdeepcnv_c3 integer, intent(in) :: & & imp_physics, ! Flag for MP scheme & imp_physics_nssl, ! Flag for NSSL scheme @@ -702,7 +702,7 @@ subroutine radiation_clouds_prop & elseif ( imp_physics == imp_physics_nssl ) then ! NSSL MP if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf .or. & - & imfdeepcnv == imfdeepcnv_unified) then ! MYNN PBL or GF or unified conv + & imfdeepcnv == imfdeepcnv_c3) then ! MYNN PBL or GF or unified conv !-- MYNN PBL or convective GF !-- use cloud fractions with SGS clouds do k=1,NLAY @@ -742,7 +742,7 @@ subroutine radiation_clouds_prop & elseif(imp_physics == imp_physics_thompson) then ! Thompson MP if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf & - & .or. imfdeepcnv == imfdeepcnv_unified) then ! MYNN PBL or GF conv + & .or. imfdeepcnv == imfdeepcnv_c3) then ! MYNN PBL or GF conv if (icloud == 3) then call progcld_thompson (plyr,plvl,tlyr,qlyr,qstl,rhly, & ! --- inputs diff --git a/physics/sgscloud_radpre.F90 b/physics/sgscloud_radpre.F90 index 07f74714a..44ab87bcc 100644 --- a/physics/sgscloud_radpre.F90 +++ b/physics/sgscloud_radpre.F90 @@ -45,7 +45,7 @@ subroutine sgscloud_radpre_run( & qr, qs, qg, & qci_conv,qlc,qli,ud_mf, & imfdeepcnv, imfdeepcnv_gf, & - imfdeepcnv_unified, & + imfdeepcnv_c3, & imfdeepcnv_sas, & qc_save, qi_save, qs_save, & qc_bl,qi_bl,cldfra_bl, & @@ -74,7 +74,7 @@ subroutine sgscloud_radpre_run( & real :: xls, xlvcp, xlscp !derived below real(kind=kind_phys) :: gfac integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & - & nlay, imfdeepcnv_sas, imfdeepcnv_unified, imp_physics, & + & nlay, imfdeepcnv_sas, imfdeepcnv_c3, imp_physics, & & imp_physics_gfdl, imp_physics_fa logical, intent(in) :: flag_init, flag_restart, do_mynnedmf @@ -273,7 +273,7 @@ subroutine sgscloud_radpre_run( & ! At this point, we have cloud properties for all non-deep convective clouds. ! So now we add the convective clouds: - if (imfdeepcnv == imfdeepcnv_gf .or. imfdeepcnv == imfdeepcnv_unified) then + if (imfdeepcnv == imfdeepcnv_gf .or. imfdeepcnv == imfdeepcnv_c3) then do k = 1, levs do i = 1, im if ( qci_conv(i,k) > 0. ) then diff --git a/physics/sgscloud_radpre.meta b/physics/sgscloud_radpre.meta index 6415358de..d5341bcd4 100644 --- a/physics/sgscloud_radpre.meta +++ b/physics/sgscloud_radpre.meta @@ -256,9 +256,9 @@ dimensions = () type = integer intent = in -[imfdeepcnv_unified] - standard_name = identifier_for_unified_deep_convection - long_name = flag for Unified deep convection scheme +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme units = flag dimensions = () type = integer