diff --git a/physics/CONV/C3/cu_c3_driver.F90 b/physics/CONV/C3/cu_c3_driver.F90 index c7e1c1f8c..203ca2d49 100644 --- a/physics/CONV/C3/cu_c3_driver.F90 +++ b/physics/CONV/C3/cu_c3_driver.F90 @@ -80,7 +80,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & sigmaout,maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in, & - ichoice_s_in,errmsg,errflg) + ichoice_s_in,ten_t,ten_u,ten_v,ten_q,dcliw,dclcw,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -120,11 +120,11 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil,delp real(kind=kind_phys), dimension ( : , : ), intent(in ), optional :: sigmain,qmicro - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs + real(kind=kind_phys), dimension( : , : ), intent(in ) :: t,us,vs real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension ( : , : ), intent(out ), optional :: sigmaout - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw + real(kind=kind_phys), dimension( : , : ), intent(in ) :: cliw, clcw real(kind=kind_phys), dimension ( : , : , :), intent(in ) :: tmf !$acc declare copyin(forcet,forceqv_spechum,w,phil) !$acc declare copy(t,us,vs,qci_conv,cliw, clcw) @@ -158,7 +158,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum - real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum + real(kind=kind_phys), dimension (:,:), intent(in) :: qv_spechum real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios @@ -172,7 +172,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: imfshalcnv integer, dimension(:), intent(inout), optional :: cactiv,cactiv_m !$acc declare copy(cactiv,cactiv_m) - + real(kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u, ten_v, dcliw, dclcw + real(kind_phys), dimension(:,:,:), intent(out) :: ten_q + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -225,7 +227,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten + real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten,new_qv_spechum,new_cliw,new_clcw real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm real(kind=kind_phys), dimension (im) :: umean,vmean,pmean,mc_thresh @@ -268,7 +270,16 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! initialize ccpp error handling variables errmsg = '' errflg = 0 - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 + dcliw = 0.0 + dclcw = 0.0 + new_clcw = clcw + new_cliw = cliw + ichoice = ichoice_in ichoicem = ichoicem_in ichoice_s = ichoice_s_in @@ -956,11 +967,12 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& cnvw(i,k)=cnvwt(i,k)*xmb(i)*dt+cnvwts(i,k)*xmbs(i)*dt+cnvwtm(i,k)*xmbm(i)*dt ud_mf(i,k)=cuten(i)*zu(i,k)*xmb(i)*dt dd_mf(i,k)=cuten(i)*zd(i,k)*edt(i)*xmb(i)*dt - t(i,k)=t(i,k)+dt*(cutens(i)*outts(i,k)+cutenm(i)*outtm(i,k)+outt(i,k)*cuten(i)) + + ten_t(i,k) = cutens(i)*outts(i,k)+cutenm(i)*outtm(i,k)+outt(i,k)*cuten(i) qv(i,k)=max(1.e-16,qv(i,k)+dt*(cutens(i)*outqs(i,k)+cutenm(i)*outqm(i,k)+outq(i,k)*cuten(i))) gdc(i,k,7)=sqrt(us(i,k)**2 +vs(i,k)**2) - us(i,k)=us(i,k)+outu(i,k)*cuten(i)*dt +outum(i,k)*cutenm(i)*dt +outus(i,k)*cutens(i)*dt - vs(i,k)=vs(i,k)+outv(i,k)*cuten(i)*dt +outvm(i,k)*cutenm(i)*dt +outvs(i,k)*cutens(i)*dt + ten_u(i,k) = outu(i,k)*cuten(i) +outum(i,k)*cutenm(i) +outus(i,k)*cutens(i) + ten_v(i,k) = outv(i,k)*cuten(i) +outvm(i,k)*cutenm(i) +outvs(i,k)*cutens(i) 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))) @@ -1005,10 +1017,13 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ) tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) if (clcw(i,k) .gt. -999.0) then - cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice - clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + new_cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice + new_clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + dcliw(i,k) = (new_cliw(i,k) - cliw(i,k))/dt + dclcw(i,k) = (new_clcw(i,k) - clcw(i,k))/dt else - cliw(i,k) = max(0.,cliw(i,k) + tem) + new_cliw(i,k) = max(0.,cliw(i,k) + tem) + dcliw(i,k) = (new_cliw(i,k) - cliw(i,k))/dt endif enddo @@ -1076,9 +1091,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! Scale dry mixing ratios for water wapor and cloud water to specific humidy / moist mixing ratios ! !$acc kernels - qv_spechum = qv/(1.0_kind_phys+qv) + new_qv_spechum = qv/(1.0_kind_phys+qv) cnvw_moist = cnvw/(1.0_kind_phys+qv) !$acc end kernels + do i=its,itf + do k=kts,kstop + ten_q(i,k,ntqv) = (new_qv_spechum(i,k) - qv_spechum(i,k))/dt + end do + end do ! ! Diagnostic tendency updates ! diff --git a/physics/CONV/C3/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta index af411cb6b..542ce1366 100644 --- a/physics/CONV/C3/cu_c3_driver.meta +++ b/physics/CONV/C3/cu_c3_driver.meta @@ -249,7 +249,7 @@ intent = in optional = True [sigmain] - standard_name = prognostic_updraft_area_fraction_in_convection + standard_name = physics_timestep_initial_prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -258,7 +258,7 @@ intent = in optional = True [sigmaout] - standard_name = updraft_area_fraction_updated_by_physics + standard_name = updraft_area_fraction long_name = convective updraft area fraction updated by physics units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -314,21 +314,21 @@ kind = kind_phys intent = out [qv_spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [cld1d] standard_name = cloud_work_function long_name = cloud work function @@ -338,23 +338,23 @@ kind = kind_phys intent = out [us] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vs] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t2di] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -370,7 +370,7 @@ kind = kind_phys intent = in [qv2di_spechum] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -453,7 +453,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [clcw] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -461,7 +461,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [pbl] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness @@ -736,6 +736,54 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[dcliw] + standard_name = tendency_of_ice_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dclcw] + standard_name = tendency_of_cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/C3/cu_c3_driver_post.meta b/physics/CONV/C3/cu_c3_driver_post.meta index 78dca2ed4..ceefceeea 100644 --- a/physics/CONV/C3/cu_c3_driver_post.meta +++ b/physics/CONV/C3/cu_c3_driver_post.meta @@ -22,7 +22,7 @@ type = integer intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -30,7 +30,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/C3/cu_c3_driver_pre.meta b/physics/CONV/C3/cu_c3_driver_pre.meta index a022cf743..e8db12948 100644 --- a/physics/CONV/C3/cu_c3_driver_pre.meta +++ b/physics/CONV/C3/cu_c3_driver_pre.meta @@ -45,7 +45,7 @@ kind = kind_phys intent = in [t] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -53,7 +53,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index 84a06f377..043c53293 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -152,7 +152,7 @@ module cs_conv !! \section general_cs_conv CS Convection Scheme General Algorithm !> @{ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & - NTR , nctp , & !DD dimensions + NTR , nctp , ntqv , & !DD dimensions otspt , lat , kdt , & t , q , rain1 , clw , & zm , zi , pap , paph , & @@ -163,22 +163,22 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & lprnt , ipr, kcnv, & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & ! for coupling to MG microphysics CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE, & - mp_phys,errmsg,errflg) + mp_phys,ten_t,ten_u,ten_v,ten_q,ten_clw,errmsg,errflg) implicit none ! ! input arguments ! - INTEGER, INTENT(IN) :: IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat, ntqv !! DD, for GFS, pass in logical, intent(in) :: otspt(:,:) ! otspt(:,1) - on/off switch for tracer transport by updraft and ! downdraft. should not include subgrid PDF and turbulence ! otspt(:,2) - on/off switch for tracer transport by subsidence ! should include subgrid PDF and turbulence - real(kind_phys), intent(inout) :: t(:,:) ! temperature at mid-layer (K) - real(kind_phys), intent(inout) :: q(:,:) ! water vapor array including moisture (kg/kg) - real(kind_phys), intent(inout) :: clw(:,:,:) ! tracer array including cloud condensate (kg/kg) + real(kind_phys), intent(in) :: t(:,:) ! temperature at mid-layer (K) + real(kind_phys), intent(in) :: q(:,:) ! water vapor array including moisture (kg/kg) + real(kind_phys), intent(in) :: clw(:,:,:) ! tracer array including cloud condensate (kg/kg) real(kind_phys), intent(in) :: pap(:,:) ! pressure at mid-layer (Pa) real(kind_phys), intent(in) :: paph(:,:) ! pressure at boundaries (Pa) real(kind_phys), intent(in) :: zm(:,:) ! geopotential at mid-layer (m) @@ -186,8 +186,8 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & real(kind_phys), intent(in) :: fscav(:), fswtr(:), wcbmaxm(:) real(kind_phys), intent(in) :: precz0in, preczhin, clmdin ! added for cs_convr - real(kind_phys), intent(inout) :: u(:,:) ! zonal wind at mid-layer (m/s) - real(kind_phys), intent(inout) :: v(:,:) ! meridional wind at mid-layer (m/s) + real(kind_phys), intent(in) :: u(:,:) ! zonal wind at mid-layer (m/s) + real(kind_phys), intent(in) :: v(:,:) ! meridional wind at mid-layer (m/s) real(kind_phys), intent(in) :: DELTA ! physics time step real(kind_phys), intent(in) :: DELTI ! dynamics time step (model time increment in seconds) @@ -204,16 +204,18 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & real(kind_phys), intent(inout), dimension(:,:) :: dd_mf, dt_mf real(kind_phys), intent(out) :: rain1(:) ! lwe thickness of deep convective precipitation amount (m) -! GJF* These variables are conditionally allocated depending on whether the -! Morrison-Gettelman microphysics is used, so they must be declared -! using assumed shape. + real(kind_phys), intent(out), dimension(:,:), optional :: qlcn, qicn, w_upi,cnv_mfd, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi -! *GJF + logical, intent(in) :: lprnt integer, intent(in) :: ipr integer, intent(inout) :: kcnv(:) ! zero if no deep convection and 1 otherwise + + real(kind_phys), intent(out), dimension(:,:) :: ten_t, ten_u, ten_v + real(kind_phys), intent(out), dimension(:,:,:) :: ten_q, ten_clw + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -248,6 +250,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! real(kind_phys) GDT(IJSDIM,KMAX) !< temperature [K] real(kind_phys) GDQ(IJSDIM,KMAX,NTR) !< tracers including moisture [kg/kg] !DDsigmadiag + real(kind_phys) new_clw(IJSDIM,KMAX,nn) !< temporary new convectively-transported tracer array used for calculating tendencies real(kind_phys) GDU(IJSDIM,KMAX) !< zonal wind [m/s] real(kind_phys) GDV(IJSDIM,KMAX) !< meridional wind [m/s] real(kind_phys) GDTM(IJSDIM,KMAX+1) !< temperature at boundaries of layers [K] @@ -263,7 +266,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & !DD real(kind_phys) :: zs(IJSDIM) !< surface height [m] integer KTMAX(IJSDIM) !< max of KT - real(kind_phys) :: ftintm, wrk, wrk1, tem + real(kind_phys) :: ftintm, wrk, wrk1, tem, new_qv integer i, k, n, ISTS, IENS, kp1 !DD borrowed from RAS to go form total condensate to ice/water separately @@ -275,6 +278,13 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 + new_clw = clw + ten_clw = 0.0 ! lprnt = kdt == 1 .and. mype == 38 ! ipr = 43 @@ -329,22 +339,22 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & !!\f] !! where T is temperature, and\f$T_1\f$ and \f$T_2\f$ are set as tcf=263.16 !! and tf= 233.16 - if (clw(1,1,2) <= -999.0) then ! input ice/water are together + if (new_clw(1,1,2) <= -999.0) then ! input ice/water are together do k=1,kmax do i=1,IJSDIM - tem = clw(i,k,1) * MAX(ZERO, MIN(ONE, (TCR-t(i,k))*TCRF)) - clw(i,k,2) = clw(i,k,1) - tem - clw(i,k,1) = tem + tem = new_clw(i,k,1) * MAX(ZERO, MIN(ONE, (TCR-t(i,k))*TCRF)) + new_clw(i,k,2) = new_clw(i,k,1) - tem + new_clw(i,k,1) = tem enddo enddo endif !DD end ras adaptation do k=1,kmax do i=1,ijsdim - tem = min(clw(i,k,1), 0.0) - wrk = min(clw(i,k,2), 0.0) - clw(i,k,1) = clw(i,k,1) - tem - clw(i,k,2) = clw(i,k,2) - wrk + tem = min(new_clw(i,k,1), 0.0) + wrk = min(new_clw(i,k,2), 0.0) + new_clw(i,k,1) = new_clw(i,k,1) - tem + new_clw(i,k,2) = new_clw(i,k,2) - wrk gdq(i,k,1) = gdq(i,k,1) + tem + wrk enddo enddo @@ -354,7 +364,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & do n=2,NTR do k=1,KMAX do i=1,IJSDIM - GDQ(i,k,n) = clw(i,k,n-1) + GDQ(i,k,n) = new_clw(i,k,n-1) enddo enddo enddo @@ -422,7 +432,8 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & do n=2,NTR do k=1,KMAX do i=1,IJSDIM - clw(i,k,n-1) = max(zero, GDQ(i,k,n) + GTQ(i,k,n) * delta) + new_clw(i,k,n-1) = max(zero, GDQ(i,k,n) + GTQ(i,k,n) * delta) + ten_clw(i,k,n-1) = (new_clw(i,k,n-1) - clw(i,k,n-1))/delta enddo enddo enddo @@ -433,10 +444,11 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! do k=1,KMAX do i=1,IJSDIM - q(i,k) = max(zero, GDQ(i,k,1) + GTQ(i,k,1) * delta) - t(i,k) = GDT(i,k) + GTT(i,k) * delta - u(i,k) = GDU(i,k) + GTU(i,k) * delta - v(i,k) = GDV(i,k) + GTV(i,k) * delta + new_qv = max(zero, GDQ(i,k,1) + GTQ(i,k,1) * delta) + ten_q(i,k,ntqv) = (new_qv - GDQ(i,k,1))/delta + ten_t(i,k) = GTT(i,k) + ten_u(i,k) = GTU(i,k) + ten_v(i,k) = GTV(i,k) ! Set the mass fluxes. ud_mf (i,k) = GMFX0(i,k) dd_mf (i,k) = GMFX1(i,k) diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta index 5211b939e..60b11fdb6 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -50,6 +50,13 @@ dimensions = () type = integer intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in [otspt] standard_name = flag_convective_tracer_transport long_name = flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] @@ -72,21 +79,21 @@ type = integer intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [rain1] standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep @@ -102,7 +109,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in [zm] standard_name = geopotential long_name = mid-layer geopotential @@ -176,21 +183,21 @@ kind = kind_phys intent = inout [u] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = mid-layer zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [v] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = mid-layer meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [fscav] standard_name = fraction_of_tracer_scavenged long_name = fraction of the tracer (aerosols) that is scavenged by convection @@ -401,6 +408,46 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[ten_clw] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 index 2d74779d1..b548a4e92 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 @@ -20,9 +20,8 @@ module cs_conv_aw_adj !! \htmlinclude cs_conv_aw_adj_run.html !! !\section gen_cs_conv_aw_adj_run CPT cs_conv_aw_adj_run General Algorithm - subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & - ntrac, ntcw, ntclamt, nncl, con_g, sigmafrac, & - gt0, gq0, save_t, save_q, prsi, cldfrac, subcldfrac, & + subroutine cs_conv_aw_adj_run(im, levs, dt, do_cscnv, do_aw, do_shoc, & + ntcw, nncl, con_g, sigmafrac, ten_t, ten_q, prsi, subcldfrac, & prcp, imp_physics, imp_physics_mg, errmsg, errflg) use machine, only: kind_phys @@ -32,17 +31,14 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & ! --- interface variables integer, intent(in) :: im, levs logical, intent(in) :: do_cscnv, do_aw, do_shoc - integer, intent(in) :: ntrac, ntcw, ntclamt, nncl - real(kind_phys), intent(in) :: con_g - real(kind_phys), dimension(:,:), intent(inout) :: sigmafrac - real(kind_phys), dimension(:,:), intent(inout) :: gt0 - real(kind_phys), dimension(:,:,:), intent(inout) :: gq0 - real(kind_phys), dimension(:,:), intent(in) :: save_t - real(kind_phys), dimension(:,:,:), intent(in) :: save_q - real(kind_phys), dimension(:,:), intent(in) :: prsi - real(kind_phys), dimension(:,:), intent(inout), optional :: cldfrac - real(kind_phys), dimension(:,:), intent(inout), optional :: subcldfrac - real(kind_phys), dimension(:), intent(inout) :: prcp + integer, intent(in) :: ntcw, nncl + real(kind_phys), intent(in) :: dt, con_g + real(kind_phys), dimension(:,:), intent(in) :: sigmafrac + real(kind_phys), dimension(:,:), intent(inout) :: ten_t + real(kind_phys), dimension(:,:,:), intent(inout) :: ten_q + real(kind_phys), dimension(:,:), intent(in) :: prsi + real(kind_phys), dimension(:,:), intent(inout), optional :: subcldfrac + real(kind_phys), dimension(:), intent(inout) :: prcp integer, intent(in ) :: imp_physics, imp_physics_mg character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -75,9 +71,9 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & do k = 1,levs do i = 1,im tem1 = sigmafrac(i,k) - gt0(i,k) = gt0(i,k) - tem1 * (gt0(i,k)-save_t(i,k)) - tem2 = tem1 * (gq0(i,k,1)-save_q(i,k,1)) - gq0(i,k,1) = gq0(i,k,1) - tem2 + ten_t(i,k) = (1.0 - tem1)*ten_t(i,k) + tem2 = tem1 * ten_q(i,k,1)*dt + ten_q(i,k,1) = (1.0 - tem1)*ten_q(i,k,1) temrain1(i) = temrain1(i) - (prsi(i,k)-prsi(i,k+1)) * tem2 * onebg enddo enddo @@ -93,8 +89,8 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & do n=ntcw,ntcw+nncl-1 do k = 1,levs do i = 1,im - tem1 = sigmafrac(i,k) * (gq0(i,k,n)-save_q(i,k,n)) - gq0(i,k,n) = gq0(i,k,n) - tem1 + tem1 = sigmafrac(i,k) * ten_q(i,k,n)*dt + ten_q(i,k,n) = (1.0 - sigmafrac(i,k))*ten_q(i,k,n) temrain1(i) = temrain1(i) - (prsi(i,k)-prsi(i,k+1)) * tem1 * onebg enddo enddo diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta index 88c3d27c7..6fe8fbaee 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta @@ -21,6 +21,14 @@ dimensions = () type = integer intent = in +[dt] + standard_name = timestep_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [do_cscnv] standard_name = flag_for_Chikira_Sugiyama_deep_convection long_name = flag for Chikira-Sugiyama convection @@ -42,13 +50,6 @@ dimensions = () type = logical intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in [ntcw] standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array long_name = tracer index for cloud condensate (or liquid water) @@ -56,13 +57,6 @@ dimensions = () type = integer intent = in -[ntclamt] - standard_name = index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array - long_name = tracer index for cloud amount integer - units = index - dimensions = () - type = integer - intent = in [nncl] standard_name = number_of_condensate_species long_name = number of cloud condensate types @@ -85,39 +79,23 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K + intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout -[gq0] - standard_name = tracer_concentration_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys intent = inout -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces @@ -126,15 +104,6 @@ type = real kind = kind_phys intent = in -[cldfrac] - standard_name = cloud_fraction_for_MG - long_name = cloud fraction used by Morrison-Gettelman MP - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout - optional = True [subcldfrac] standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 index 8cc1020d4..f750d8296 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 @@ -7,10 +7,8 @@ module cs_conv_pre !! \section arg_table_cs_conv_pre_run Argument Table !! \htmlinclude cs_conv_pre_run.html !! - subroutine cs_conv_pre_run(im, levs, ntrac, q, clw1, clw2, & - & work1, work2, cs_parm1, cs_parm2, wcbmax, & - & fswtr, fscav, save_q1, save_q2, save_q3, & - & errmsg, errflg) + subroutine cs_conv_pre_run(im, levs, work1, work2, cs_parm1, cs_parm2, wcbmax, & + & fswtr, fscav, errmsg, errflg) use machine , only : kind_phys @@ -18,18 +16,13 @@ subroutine cs_conv_pre_run(im, levs, ntrac, q, clw1, clw2, & implicit none ! --- inputs - integer, intent(in) :: im, levs, ntrac - real(kind_phys), dimension(:,:), intent(in) :: q - real(kind_phys), dimension(:,:), intent(in) :: clw1,clw2 + integer, intent(in) :: im, levs real(kind_phys), dimension(:), intent(in) :: work1, work2 real(kind_phys), intent(in) :: cs_parm1, cs_parm2 ! --- input/output real(kind_phys), dimension(:), intent(out) :: fswtr, fscav real(kind_phys), dimension(:), intent(out) :: wcbmax - real(kind_phys), dimension(:,:), intent(out) :: save_q1,save_q2 - ! save_q3 is not allocated for Zhao-Carr MP - real(kind_phys), dimension(:,:), intent(out) :: save_q3 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -47,16 +40,6 @@ subroutine cs_conv_pre_run(im, levs, ntrac, q, clw1, clw2, & fswtr(:) = 0.0 fscav(:) = 0.0 - do k=1,levs - do i=1,im - ! DH* note - save_q1 assignment may be redundant, - ! because already done in GFS_DCNV_generic_pre? - ! Keep for using cs_conv w/o GFS_DCNV_generic_pre? - save_q1(i,k) = q(i,k) - save_q2(i,k) = max(0.0,clw2(i,k)) - save_q3(i,k) = max(0.0,clw1(i,k)) - enddo - enddo return end subroutine cs_conv_pre_run diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta index 7ce80496b..dc61b683a 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta @@ -21,37 +21,6 @@ dimensions = () type = integer intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[q] - standard_name = specific_humidity_of_new_state - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[clw1] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[clw2] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [work1] standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes @@ -108,30 +77,6 @@ type = real kind = kind_phys intent = out -[save_q1] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[save_q2] - standard_name = cloud_condensed_water_mixing_ratio_save - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[save_q3] - standard_name = ice_water_mixing_ratio_save - long_name = cloud ice water mixing ratio before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 index 47bddd799..2a0c05372 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 @@ -68,7 +68,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & - do_smoke_transport,kdt,errmsg,errflg) + do_smoke_transport,kdt,ten_t,ten_u,ten_v,ten_q,dcliw,dclcw,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -110,10 +110,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co !$acc declare copyin(dtidx) real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs + real(kind=kind_phys), dimension( : , : ), intent(in ) :: t,us,vs real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw + real(kind=kind_phys), dimension( : , : ), intent(in ) :: cliw, clcw !$acc declare copyin(forcet,forceqv_spechum,w,phil) !$acc declare copy(t,us,vs,qci_conv,cliw, clcw) !$acc declare copyout(cnvw_moist,cnvc) @@ -145,7 +145,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum - real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum + real(kind=kind_phys), dimension (:,:), intent(in) :: qv_spechum real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios @@ -163,7 +163,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d real(kind_phys), dimension(:,:), intent(inout), optional :: wetdpc_deep !$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep) - + real(kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u, ten_v, dcliw, dclcw + real(kind_phys), dimension(:,:,:), intent(out) :: ten_q + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -217,7 +219,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten + real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten,new_qv_spechum,new_cliw,new_clcw real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm real(kind=kind_phys), dimension (im) :: umean,vmean,pmean,mc_thresh @@ -260,7 +262,16 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! initialize ccpp error handling variables errmsg = '' errflg = 0 - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 + dcliw = 0.0 + dclcw = 0.0 + new_clcw = clcw + new_cliw = cliw + ichoice = ichoice_in ichoicem = ichoicem_in ichoice_s = ichoice_s_in @@ -935,11 +946,12 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co cnvw(i,k)=cnvwt(i,k)*xmb(i)*dt+cnvwts(i,k)*xmbs(i)*dt+cnvwtm(i,k)*xmbm(i)*dt ud_mf(i,k)=cuten(i)*zu(i,k)*xmb(i)*dt dd_mf(i,k)=cuten(i)*zd(i,k)*edt(i)*xmb(i)*dt - t(i,k)=t(i,k)+dt*(cutens(i)*outts(i,k)+cutenm(i)*outtm(i,k)+outt(i,k)*cuten(i)) + + ten_t(i,k) = (cutens(i)*outts(i,k)+cutenm(i)*outtm(i,k)+outt(i,k)*cuten(i)) qv(i,k)=max(1.e-16,qv(i,k)+dt*(cutens(i)*outqs(i,k)+cutenm(i)*outqm(i,k)+outq(i,k)*cuten(i))) gdc(i,k,7)=sqrt(us(i,k)**2 +vs(i,k)**2) - us(i,k)=us(i,k)+outu(i,k)*cuten(i)*dt +outum(i,k)*cutenm(i)*dt +outus(i,k)*cutens(i)*dt - vs(i,k)=vs(i,k)+outv(i,k)*cuten(i)*dt +outvm(i,k)*cutenm(i)*dt +outvs(i,k)*cutens(i)*dt + ten_u(i,k) = outu(i,k)*cuten(i) +outum(i,k)*cutenm(i) +outus(i,k)*cutens(i) + ten_v(i,k) = outv(i,k)*cuten(i) +outvm(i,k)*cutenm(i) +outvs(i,k)*cutens(i) 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))) @@ -984,12 +996,15 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ) tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) if (clcw(i,k) .gt. -999.0) then - cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice - clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + new_cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice + new_clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + dcliw(i,k) = (new_cliw(i,k) - cliw(i,k))/dt + dclcw(i,k) = (new_clcw(i,k) - clcw(i,k))/dt else - cliw(i,k) = max(0.,cliw(i,k) + tem) + new_cliw(i,k) = max(0.,cliw(i,k) + tem) + dcliw(i,k) = (new_cliw(i,k) - cliw(i,k))/dt endif - + enddo gdc(i,1,10)=forcing(i,1) @@ -1051,9 +1066,14 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! Scale dry mixing ratios for water wapor and cloud water to specific humidy / moist mixing ratios ! !$acc kernels - qv_spechum = qv/(1.0_kind_phys+qv) + new_qv_spechum = qv/(1.0_kind_phys+qv) cnvw_moist = cnvw/(1.0_kind_phys+qv) !$acc end kernels + do i=its,itf + do k=kts,kstop + ten_q(i,k,ntqv) = (new_qv_spechum(i,k) - qv_spechum(i,k))/dt + end do + end do ! ! Diagnostic tendency updates ! diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index 39a20f755..1c189ce7b 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -204,21 +204,21 @@ kind = kind_phys intent = out [qv_spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [cld1d] standard_name = cloud_work_function long_name = cloud work function @@ -228,23 +228,23 @@ kind = kind_phys intent = out [us] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vs] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t2di] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -260,7 +260,7 @@ kind = kind_phys intent = in [qv2di_spechum] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -342,7 +342,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [clcw] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -350,7 +350,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [pbl] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness @@ -678,6 +678,54 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[dcliw] + standard_name = tendency_of_ice_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dclcw] + standard_name = tendency_of_cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta index f1113302c..d986d450f 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta @@ -22,7 +22,7 @@ type = integer intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -30,7 +30,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -122,7 +122,7 @@ intent = inout optional = True [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta index 7635e3170..1385dd704 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta @@ -45,7 +45,7 @@ kind = kind_phys intent = in [t] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -53,7 +53,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -160,7 +160,7 @@ intent = inout optional = True [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/CONV/RAS/rascnv.F90 b/physics/CONV/RAS/rascnv.F90 index 37945bed4..1817e2812 100644 --- a/physics/CONV/RAS/rascnv.F90 +++ b/physics/CONV/RAS/rascnv.F90 @@ -292,6 +292,7 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & &, DDVEL, ud_mf, dd_mf, dt_mf & &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, ten_t, ten_u, ten_v, ten_q, ten_cc & &, errmsg, errflg) ! !********************************************************************* @@ -328,7 +329,7 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & ! real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsik, phii - real(kind=kind_phys), dimension(:,:), intent(inout) :: tin, qin, uin, vin + real(kind=kind_phys), dimension(:,:), intent(in) :: tin, qin, uin, vin real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, prslk, phil & &, rhc real(kind=kind_phys), dimension(:,:), intent(out) :: ud_mf @@ -342,7 +343,7 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & real(kind=kind_phys), dimension(:) , intent(out) :: rainc real(kind=kind_phys), dimension(:) , intent(out) :: ddvel real(kind=kind_phys), dimension(:,:), intent(in) :: rannum - real(kind=kind_phys), intent(inout) :: ccin(:,:,:) + real(kind=kind_phys), intent(in) :: ccin(:,:,:) real(kind=kind_phys), intent(in) :: dt, dtf ! ! Added for aerosol scavenging for GOCART @@ -350,6 +351,8 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & real(kind=kind_phys), intent(in) :: fscav(:) ! &, ctei_r(im), ctei_rm + real(kind=kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u, ten_v + real(kind=kind_phys), dimension(:,:,:), intent(out) :: ten_q, ten_cc character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -400,7 +403,13 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & end if trcmin = -99999.0_kp if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_kp - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 + ten_cc = 0.0 + !> - Initialize CCPP error handling variables errmsg = '' @@ -472,6 +481,8 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem if (ccwfac == zero) ccwfac = half + qli_l = ccin(ipt,:,2) + qii_l = ccin(ipt,:,1) ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -602,15 +613,20 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & ll = kp1 -l tem = ccin(ipt,ll,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) - ccin(ipt,ll,2) = ccin(ipt,ll,1) - tem - ccin(ipt,ll,1) = tem +!##### GJF - change to something else + qli_l(ll) = ccin(ipt,ll,1) - tem + qii_l(ll) = tem + !ccin(ipt,ll,2) = ccin(ipt,ll,1) - tem + !ccin(ipt,ll,1) = tem enddo endif if (advcld) then do l=1,k ll = kp1 -l ! Input variables are bottom to top! - QII(L) = ccin(ipt,ll,1) - QLI(L) = ccin(ipt,ll,2) + QII(L) = qii_l(ll) + QLI(L) = qli_l(ll) + !QII(L) = ccin(ipt,ll,1) + !QLI(L) = ccin(ipt,ll,2) enddo endif KBL = MAX(MIN(k, kp1-KPBL(ipt)), k/2) @@ -649,14 +665,19 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & do l=1,k tem = ccin(ipt,l,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) - ccin(ipt,l,2) = ccin(ipt,l,1) - tem - ccin(ipt,l,1) = tem +!##### GJF - change to something else + qli_l(l) = ccin(ipt,l,1) - tem + qii_l(l) = tem + !ccin(ipt,l,2) = ccin(ipt,l,1) - tem + !ccin(ipt,l,1) = tem enddo endif if (advcld) then do l=1,k - QII(L) = ccin(ipt,l,1) - QLI(L) = ccin(ipt,l,2) + qii(l) = qii_l(l) + qli(l) = qli_l(l) + !QII(L) = ccin(ipt,l,1) + !QLI(L) = ccin(ipt,l,2) enddo endif ! @@ -967,16 +988,24 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & if (flipv) then do l=1,k ll = kp1 - l - tin(ipt,ll) = toi(l) ! Temperature - qin(ipt,ll) = qoi(l) ! Specific humidity - uin(ipt,ll) = uvi(l,ntr+1) ! U momentum - vin(ipt,ll) = uvi(l,ntr+2) ! V momentum +!##### GJF - change to tendencies + ten_t(ipt,ll) = (toi(l) - tin(ipt,ll))/dt + ten_q(ipt,ll,1) = (qoi(l) - qin(ipt,ll))/dt + ten_u(ipt,ll) = (uvi(l,ntr+1) - uin(ipt,ll))/dt + ten_v(ipt,ll) = (uvi(l,ntr+1) - vin(ipt,ll))/dt + !tin(ipt,ll) = toi(l) ! Temperature + !qin(ipt,ll) = qoi(l) ! Specific humidity + !uin(ipt,ll) = uvi(l,ntr+1) ! U momentum + !vin(ipt,ll) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == mp_phys_mg) then if (advcld) then - QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) - QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) +!##### GJF - adjust to match ccin changes above + QLCN(ipt,ll) = max(qli(l)-qli_l(ll), zero) + QICN(ipt,ll) = max(qii(l)-qii_l(ll), zero) + !QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) + !QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) CNV_FICE(ipt,ll) = QICN(ipt,ll) & & / max(1.0e-10_kp,QLCN(ipt,ll)+QICN(ipt,ll)) else @@ -993,22 +1022,30 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & endif if (ntr > 0) then +!##### GJF - change to tendencies do n=1,ntr - ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers + ten_cc(ipt,ll,n+2) = (uvi(l,n) - ccin(ipt,ll,n+2)) + !ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers enddo endif enddo if (advcld) then do l=1,k ll = kp1 - l - ccin(ipt,ll,1) = qii(l) ! Cloud ice - ccin(ipt,ll,2) = qli(l) ! Cloud water +!##### GJF - change to tendencies + ten_cc(ipt,ll,1) = (qii(l) - ccin(ipt,ll,1))/dt + ten_cc(ipt,ll,2) = (qli(l) - ccin(ipt,ll,2))/dt + !ccin(ipt,ll,1) = qii(l) ! Cloud ice + !ccin(ipt,ll,2) = qli(l) ! Cloud water enddo else do l=1,k ll = kp1 - l - ccin(ipt,ll,1) = ccin(ipt,ll,1) + cli(l) - ccin(ipt,ll,2) = ccin(ipt,ll,2) + clw(l) +!##### GJF - change to tendencies + ten_cc(ipt,ll,1) = cli(l)/dt + ten_cc(ipt,ll,2) = clw(l)/dt + !ccin(ipt,ll,1) = ccin(ipt,ll,1) + cli(l) + !ccin(ipt,ll,2) = ccin(ipt,ll,2) + clw(l) enddo endif ! @@ -1018,16 +1055,24 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & else do l=1,k - tin(ipt,l) = toi(l) ! Temperature - qin(ipt,l) = qoi(l) ! Specific humidity - uin(ipt,l) = uvi(l,ntr+1) ! U momentum - vin(ipt,l) = uvi(l,ntr+2) ! V momentum +!##### GJF - change to tendencies + ten_t(ipt,l) = (toi(l) - tin(ipt,l))/dt + ten_q(ipt,l,1) = (qoi(l) - qin(ipt,l))/dt + ten_u(ipt,l) = (uvi(l,ntr+1) - uin(ipt,l))/dt + ten_v(ipt,l) = (uvi(l,ntr+2) - vin(ipt,l))/dt + !tin(ipt,l) = toi(l) ! Temperature + !qin(ipt,l) = qoi(l) ! Specific humidity + !uin(ipt,l) = uvi(l,ntr+1) ! U momentum + !vin(ipt,l) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables if (mp_phys == mp_phys_mg) then if (advcld) then - QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) - QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) +!##### GJF - change to match change to ccin above + QLCN(ipt,l) = max(qli(l)-qli_l(l), zero) + QICN(ipt,l) = max(qii(l)-qii_l(l), zero) + !QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) + !QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) CNV_FICE(ipt,l) = QICN(ipt,l) & & / max(1.0e-10_kp,QLCN(ipt,l)+QICN(ipt,l)) else @@ -1047,20 +1092,28 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & endif if (ntr > 0) then +!##### GJF - change to tendencies do n=1,ntr - ccin(ipt,l,n+2) = uvi(l,n) ! Tracers + ten_cc(ipt,l,n+2) = (uvi(l,n) - ccin(ipt,l,n+2))/dt + !ccin(ipt,l,n+2) = uvi(l,n) ! Tracers enddo endif enddo if (advcld) then +!##### GJF - change to tendencies do l=1,k - ccin(ipt,l,1) = qii(l) ! Cloud ice - ccin(ipt,l,2) = qli(l) ! Cloud water + ten_cc(ipt,l,1) = (qii(l) - ccin(ipt,l,1))/dt + ten_cc(ipt,l,2) = (qli(l) - ccin(ipt,l,2))/dt + !ccin(ipt,l,1) = qii(l) ! Cloud ice + !ccin(ipt,l,2) = qli(l) ! Cloud water enddo else +!##### GJF - change to tendencies do l=1,k - ccin(ipt,l,1) = ccin(ipt,l,1) + cli(l) - ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) + ten_cc(ipt,l,1) = cli(l)/dt + ten_cc(ipt,l,2) = clw(l)/dt + !ccin(ipt,l,1) = ccin(ipt,l,1) + cli(l) + !ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) enddo endif endif diff --git a/physics/CONV/RAS/rascnv.meta b/physics/CONV/RAS/rascnv.meta index 9969e10b5..ec3772df0 100644 --- a/physics/CONV/RAS/rascnv.meta +++ b/physics/CONV/RAS/rascnv.meta @@ -335,37 +335,37 @@ kind = kind_phys intent = in [tin] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qin] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = updated vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [uin] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vin] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [ccin] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers @@ -373,7 +373,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in [fscav] standard_name = chemical_tracer_scavenging_fractions long_name = array of aerosol scavenging coefficients @@ -596,6 +596,46 @@ kind = kind_phys intent = inout optional = True +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[ten_cc] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index 48bbc5840..83e007aad 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -73,11 +73,11 @@ end subroutine samfdeepcnv_init !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! !! \section samfdeep_detailed GFS samfdeepcnv Detailed Algorithm - subroutine samfdeepcnv_run (im,km,first_time_step,restart, & + subroutine samfdeepcnv_run (im,km,nn,first_time_step,restart, & & tmf,qmicro,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & - & t0c,delt,ntk,ntr,delp, & - & prslp,psp,phil,tkeh,qtr,prevsq,q,q1,t1,u1,v1,fscav, & + & t0c,delt,ntk,ntr,delp, ten_t, ten_u, ten_v, ten_q, & + & prslp,psp,phil,tkeh,qtr,dqtr,prevsq,q,q1,t1,u1,v1,fscav, & & hwrf_samfdeep,progsigma,progomega,cldwrk,rn,kbot,ktop,kcnv, & & islimsk,garea,dot,ncloud,hpbl,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & @@ -93,7 +93,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & implicit none ! - integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, nn, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, eps, epsm1, & & fv, grav, hvap, rd, rv, t0c @@ -116,22 +116,20 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & - & q1(:,:), t1(:,:), u1(:,:), v1(:,:), & - & cnvw(:,:), cnvc(:,:), tkeh(:,:) + real(kind=kind_phys), intent(inout) :: cnvw(:,:), cnvc(:,:), & + & tkeh(:,:) + + real(kind=kind_phys), intent(in) :: qtr(:,:,:), q1(:,:) + real(kind=kind_phys), intent(in) :: t1(:,:), u1(:,:), v1(:,:) integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: cldwrk(:), & & rn(:), & & dd_mf(:,:), dt_mf(:,:) real(kind=kind_phys), intent(out) :: ud_mf(:,:) - ! GJF* These variables are conditionally allocated depending on whether the - ! Morrison-Gettelman microphysics is used, so they must be declared - ! using assumed shape. real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & & qlcn, qicn, w_upi, cnv_mfd, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop, cnv_nice, cf_upi - ! *GJF integer, intent(in) :: mp_phys, mp_phys_mg real(kind=kind_phys), intent(in) :: clam, c0s, c1, & @@ -312,6 +310,24 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & real(kind=kind_phys) tf, tcr, tcrf parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) + real(kind=kind_phys), intent(out) :: ten_t(:,:), ten_u(:,:), & + & ten_v(:,:), ten_q(:,:,:), dqtr(:,:,:) + + real(kind=kind_phys) :: new_t1(im,km),new_u1(im,km),new_v1(im,km),& + & new_q1(im,km),new_qtr(im,km,nn) + + ten_t = 0._kind_phys + ten_u = 0._kind_phys + ten_v = 0._kind_phys + ten_q = 0._kind_phys + dqtr = 0._kind_phys + + new_t1 = t1 + new_u1 = u1 + new_v1 = v1 + new_q1 = q1 + new_qtr = qtr + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -3150,13 +3166,13 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(k <= ktcon(i)) then tem2 = xmb(i) * dt2 dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp - t1(i,k) = t1(i,k) + tem2 * dellat - q1(i,k) = q1(i,k) + tem2 * dellaq(i,k) + new_t1(i,k) = t1(i,k) + tem2 * dellat + new_q1(i,k) = q1(i,k) + tem2 * dellaq(i,k) ! tem = tem2 / rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * tem - u1(i,k) = u1(i,k) + tem2 * dellau(i,k) - v1(i,k) = v1(i,k) + tem2 * dellav(i,k) + new_u1(i,k) = u1(i,k) + tem2 * dellau(i,k) + new_v1(i,k) = v1(i,k) + tem2 * dellav(i,k) dp = 1000. * del(i,k) tem = xmb(i) * dp / grav delhbar(i) = delhbar(i) + tem * dellah(i,k) @@ -3180,9 +3196,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do k = 1,km1 do i = 1,im if(cnvflg(i) .and. k <= ktcon(i)) then - tem = q1(i,k) * delp(i,k) / grav - if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem - if(q1(i,k) > 0.) tsump(i) = tsump(i) + tem + tem = new_q1(i,k) * delp(i,k) / grav + if(new_q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(new_q1(i,k) > 0.) tsump(i) = tsump(i) + tem endif enddo enddo @@ -3202,11 +3218,13 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(cnvflg(i) .and. k <= ktcon(i)) then if(rtnp(i) < 0.) then if(tsump(i) > abs(tsumn(i))) then - if(q1(i,k) < 0.) q1(i,k) = 0. - if(q1(i,k) > 0.) q1(i,k) = (1.+rtnp(i))*q1(i,k) + if(new_q1(i,k) < 0.) new_q1(i,k) = 0. + if(new_q1(i,k) > 0.) new_q1(i,k) = & + & (1.+rtnp(i))*new_q1(i,k) else - if(q1(i,k) < 0.) q1(i,k) = (1.+rtnp(i))*q1(i,k) - if(q1(i,k) > 0.) q1(i,k) = 0. + if(new_q1(i,k) < 0.) new_q1(i,k) = & + & (1.+rtnp(i))*new_q1(i,k) + if(new_q1(i,k) > 0.) new_q1(i,k) = 0. endif endif endif @@ -3286,7 +3304,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do k = 1, km do i = 1, im if(cnvflg(i) .and. k <= ktcon(i)) then - qtr(i,k,kk) = ctr(i,k,n) + new_qtr(i,k,kk) = ctr(i,k,n) endif enddo enddo @@ -3316,15 +3334,16 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if (cnvflg(i)) then if(k > kb(i) .and. k < ktcon(i)) then dp = 1000. * del(i,k) - if (qtr(i,k,kk) < 0.) then + if (new_qtr(i,k,kk) < 0.) then ! borrow negative mass from wet deposition - tem = -qtr(i,k,kk)*dp + tem = -new_qtr(i,k,kk)*dp if(wet_dep(i,k,n) >= tem) then wet_dep(i,k,n) = wet_dep(i,k,n) - tem - qtr(i,k,kk) = 0. + new_qtr(i,k,kk) = 0. else wet_dep(i,k,n) = 0. - qtr(i,k,kk) = qtr(i,k,kk)+wet_dep(i,k,n)/dp + new_qtr(i,k,kk) = new_qtr(i,k,kk)+ & + & wet_dep(i,k,n)/dp endif endif endif @@ -3343,7 +3362,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do i = 1, im if (cnvflg(i) .and. k <= kmax(i)) then if(k <= ktcon(i)) then - qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = 0.01 * fpvs(new_t1(i,k)) ! fpvs is in pa qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) val = 1.e-8 qeso(i,k) = max(qeso(i,k), val ) @@ -3394,8 +3413,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! evef = edt(i) * evfact ! if(islimsk(i) == 1) evef=edt(i) * evfactl ! if(islimsk(i) == 1) evef=.07 - qcond(i) = evef * (q1(i,k) - qeso(i,k)) - & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + qcond(i) = evef * (new_q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / new_t1(i,k)**2) dp = 1000. * del(i,k) tem = grav / dp tem1 = dp / grav @@ -3410,8 +3429,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & flg(i) = .false. endif if(rn(i) > 0. .and. qevap(i) > 0.) then - q1(i,k) = q1(i,k) + qevap(i) - t1(i,k) = t1(i,k) - elocp * qevap(i) + new_q1(i,k) = new_q1(i,k) + qevap(i) + new_t1(i,k) = new_t1(i,k) - elocp * qevap(i) rn(i) = rn(i) - .001 * qevap(i) * tem1 deltv(i) = - elocp*qevap(i)/dt2 delq(i) = + qevap(i)/dt2 @@ -3509,12 +3528,12 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! if (k > kb(i) .and. k <= ktcon(i)) then if (k >= kbcon(i) .and. k <= ktcon(i)) then tem = dellal(i,k) * xmb(i) * dt2 - tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) - if (qtr(i,k,2) > -999.0) then - qtr(i,k,1) = qtr(i,k,1) + tem * tem1 ! ice - qtr(i,k,2) = qtr(i,k,2) + tem *(1.0-tem1) ! water + tem1 = max(0.0, min(1.0, (tcr-new_t1(i,k))*tcrf)) + if (new_qtr(i,k,2) > -999.0) then + new_qtr(i,k,1) = new_qtr(i,k,1) + tem * tem1 ! ice + new_qtr(i,k,2) = new_qtr(i,k,2) + tem *(1.0-tem1) ! water else - qtr(i,k,1) = qtr(i,k,1) + tem + new_qtr(i,k,1) = new_qtr(i,k,1) + tem endif endif endif @@ -3528,10 +3547,10 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do i = 1, im if(cnvflg(i) .and. rn(i) <= 0.) then if (k <= kmax(i)) then - t1(i,k) = to(i,k) - q1(i,k) = qo(i,k) - u1(i,k) = uo(i,k) - v1(i,k) = vo(i,k) + new_t1(i,k) = to(i,k) + new_q1(i,k) = qo(i,k) + new_u1(i,k) = uo(i,k) + new_v1(i,k) = vo(i,k) endif endif enddo @@ -3543,7 +3562,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do i = 1, im if(cnvflg(i) .and. rn(i) <= 0.) then if (k <= kmax(i)) then - qtr(i,k,kk)= ctro(i,k,n) + new_qtr(i,k,kk)= ctro(i,k,n) endif endif enddo @@ -3569,7 +3588,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do k = 1, km ! do i = 1, im ! if(cnvflg(i) .and. rn(i) > 0.) then -! if (k <= kmax(i)) qtr(i,k,kk) = qaero(i,k,n) +! if (k <= kmax(i)) new_qtr(i,k,kk) = qaero(i,k,n) ! endif ! enddo ! enddo @@ -3619,14 +3638,14 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(cnvflg(i) .and. rn(i) > 0.) then if(k > kb(i) .and. k < ktop(i)) then tem = 0.5 * (eta(i,k-1) + eta(i,k)) * xmb(i) - tem1 = pfld(i,k) * 100. / (rd * t1(i,k)) + tem1 = pfld(i,k) * 100. / (rd * new_t1(i,k)) if(progsigma)then tem2 = sigmab(i) else tem2 = max(sigmagfm(i), betaw) endif ptem = tem / (tem2 * tem1) - qtr(i,k,ntk)=qtr(i,k,ntk)+0.5*tem2*ptem*ptem + new_qtr(i,k,ntk)=new_qtr(i,k,ntk)+0.5*tem2*ptem*ptem endif endif enddo @@ -3637,14 +3656,14 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(cnvflg(i) .and. rn(i) > 0.) then if(k > 1 .and. k <= jmin(i)) then tem = 0.5*edto(i)*(etad(i,k-1)+etad(i,k))*xmb(i) - tem1 = pfld(i,k) * 100. / (rd * t1(i,k)) + tem1 = pfld(i,k) * 100. / (rd * new_t1(i,k)) if(progsigma)then tem2 = sigmab(i) else tem2 = max(sigmagfm(i), betaw) endif ptem = tem / (tem2 * tem1) - qtr(i,k,ntk)=qtr(i,k,ntk)+0.5*tem2*ptem*ptem + new_qtr(i,k,ntk)=new_qtr(i,k,ntk)+0.5*tem2*ptem*ptem endif endif enddo @@ -3655,10 +3674,10 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(mp_phys == mp_phys_mg) then do k=1,km do i=1,im - QLCN(i,k) = qtr(i,k,2) - qlcn(i,k) - QICN(i,k) = qtr(i,k,1) - qicn(i,k) + QLCN(i,k) = new_qtr(i,k,2) - qlcn(i,k) + QICN(i,k) = new_qtr(i,k,1) - qicn(i,k) cf_upi(i,k) = cnvc(i,k) - w_upi(i,k) = ud_mf(i,k)*t1(i,k)*rd / + w_upi(i,k) = ud_mf(i,k)*new_t1(i,k)*rd / & (dt2*max(sigmagfm(i),1.e-12)*prslp(i,k)) CNV_MFD(i,k) = ud_mf(i,k)/dt2 CLCN(i,k) = cnvc(i,k) @@ -3668,6 +3687,13 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo endif endif ! (.not.hwrf_samfdeep) + + ten_t = (new_t1 - t1)/delt + ten_q(:,:,1) = (new_q1 - q1)/delt + ten_u = (new_u1 - u1)/delt + ten_v = (new_v1 - v1)/delt + dqtr = (new_qtr - qtr)/delt + return end subroutine samfdeepcnv_run diff --git a/physics/CONV/SAMF/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta index 1fc5fdf62..ee43597ac 100644 --- a/physics/CONV/SAMF/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -55,6 +55,13 @@ dimensions = () type = integer intent = in +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in [first_time_step] standard_name = flag_for_first_timestep long_name = flag for first time step for time integration loop (cold/warmstart) @@ -265,7 +272,15 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in +[dqtr] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = out [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = specific_humidity_on_previous_timestep @@ -276,7 +291,7 @@ intent = in optional = True [q] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -284,37 +299,69 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = updated vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t1] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [u1] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [v1] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [fscav] standard_name = chemical_tracer_scavenging_fractions long_name = array of aerosol scavenging coefficients @@ -460,7 +507,7 @@ kind = kind_phys intent = inout [sigmain] - standard_name = prognostic_updraft_area_fraction_in_convection + standard_name = physics_timestep_initial_prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -469,7 +516,7 @@ intent = in optional = True [sigmaout] - standard_name = updraft_area_fraction_updated_by_physics + standard_name = updraft_area_fraction long_name = convective updraft area fraction updated by physics units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index bc69f0ebb..0f3937058 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -50,13 +50,13 @@ end subroutine samfshalcnv_init !! -# Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! \section det_samfshalcnv GFS samfshalcnv Detailed Algorithm - subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & + subroutine samfshalcnv_run(im,km,nn,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp,first_time_step,restart, & & tmf,qmicro,progsigma,progomega, & - & prslp,psp,phil,tkeh,qtr,prevsq,q,q1,t1,u1,v1,fscav, & - & rn,kbot,ktop,kcnv,islimsk,garea,cscale, & - & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & + & prslp,psp,phil,tkeh,qtr,dqtr,prevsq,q,q1,t1,u1,v1,fscav, & + & rn,kbot,ktop,kcnv,islimsk,garea,cscale,ten_t, ten_u, ten_v, & + & ten_q, dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & & sigmain,sigmaout,omegain,omegaout,betadcu,betamcu,betascu, & & errmsg,errflg) @@ -66,7 +66,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, nn, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & & eps, epsm1, fv, grav, hvap, rd, rv, t0c, betascu, betadcu, & @@ -83,8 +83,11 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & - & q1(:,:), t1(:,:), u1(:,:), v1(:,:), tkeh(:,:) + real(kind=kind_phys), intent(inout) :: tkeh(:,:) + real(kind=kind_phys), intent(in) :: qtr(:,:,:), & + & q1(:,:) + + real(kind=kind_phys), intent(in) :: t1(:,:), u1(:,:), v1(:,:) ! integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: rn(:), & @@ -252,6 +255,23 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys) tf, tcr, tcrf parameter (tf=233.16, tcr=263.16, tcrf=1.0/(tcr-tf)) + real(kind=kind_phys), intent(out) :: ten_t(:,:), ten_u(:,:), & + & ten_v(:,:), ten_q(:,:,:), dqtr(:,:,:) + + real(kind=kind_phys) :: new_t1(im,km),new_u1(im,km),new_v1(im,km),& + & new_q1(im,km), new_qtr(im,km,nn) + + ten_t = 0._kind_phys + ten_u = 0._kind_phys + ten_v = 0._kind_phys + ten_q = 0._kind_phys + dqtr = 0._kind_phys + + new_t1 = t1 + new_u1 = u1 + new_v1 = v1 + new_q1 = q1 + new_qtr = qtr c----------------------------------------------------------------------- ! @@ -2127,13 +2147,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then dellat = (dellah(i,k) - hvap * dellaq(i,k)) / cp - t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 - q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 + new_t1(i,k) = t1(i,k) + dellat * xmb(i) * dt2 + new_q1(i,k) = q1(i,k) + dellaq(i,k) * xmb(i) * dt2 ! tem = 1./rcs(i) ! u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 * tem ! v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 * tem - u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 - v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 + new_u1(i,k) = u1(i,k) + dellau(i,k) * xmb(i) * dt2 + new_v1(i,k) = v1(i,k) + dellav(i,k) * xmb(i) * dt2 dp = 1000. * del(i,k) tem = xmb(i) * dp / grav delhbar(i) = delhbar(i) + tem * dellah(i,k) @@ -2158,9 +2178,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & do i = 1,im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then - tem = q1(i,k) * delp(i,k) / grav - if(q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem - if(q1(i,k) > 0.) tsump(i) = tsump(i) + tem + tem = new_q1(i,k) * delp(i,k) / grav + if(new_q1(i,k) < 0.) tsumn(i) = tsumn(i) + tem + if(new_q1(i,k) > 0.) tsump(i) = tsump(i) + tem endif endif enddo @@ -2182,11 +2202,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if(k > kb(i) .and. k <= ktcon(i)) then if(rtnp(i) < 0.) then if(tsump(i) > abs(tsumn(i))) then - if(q1(i,k) < 0.) q1(i,k)= 0. - if(q1(i,k) > 0.) q1(i,k)=(1.+rtnp(i))*q1(i,k) + if(new_q1(i,k) < 0.) new_q1(i,k)= 0. + if(new_q1(i,k) > 0.) new_q1(i,k)= & + & (1.+rtnp(i))*new_q1(i,k) else - if(q1(i,k) < 0.) q1(i,k)=(1.+rtnp(i))*q1(i,k) - if(q1(i,k) > 0.) q1(i,k)=0. + if(new_q1(i,k) < 0.) new_q1(i,k)= & + & (1.+rtnp(i))*new_q1(i,k) + if(new_q1(i,k) > 0.) new_q1(i,k)=0. endif endif endif @@ -2273,7 +2295,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & do i = 1, im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then - qtr(i,k,kk) = ctr(i,k,n) + new_qtr(i,k,kk) = ctr(i,k,n) endif endif enddo @@ -2304,15 +2326,16 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if (cnvflg(i)) then if(k > kb(i) .and. k < ktcon(i)) then dp = 1000. * del(i,k) - if (qtr(i,k,kk) < 0.) then + if (new_qtr(i,k,kk) < 0.) then ! borrow negative mass from wet deposition - tem = -qtr(i,k,kk)*dp + tem = -new_qtr(i,k,kk)*dp if(wet_dep(i,k,n) >= tem) then wet_dep(i,k,n) = wet_dep(i,k,n) - tem - qtr(i,k,kk) = 0. + new_qtr(i,k,kk) = 0. else wet_dep(i,k,n) = 0. - qtr(i,k,kk) = qtr(i,k,kk)+wet_dep(i,k,n)/dp + new_qtr(i,k,kk) = new_qtr(i,k,kk)+ & + & wet_dep(i,k,n)/dp endif endif endif @@ -2331,7 +2354,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & do i = 1, im if (cnvflg(i)) then if(k > kb(i) .and. k <= ktcon(i)) then - qeso(i,k) = 0.01 * fpvs(t1(i,k)) ! fpvs is in pa + qeso(i,k) = 0.01 * fpvs(new_t1(i,k)) ! fpvs is in pa qeso(i,k) = eps * qeso(i,k)/(pfld(i,k) + epsm1*qeso(i,k)) val = 1.e-8 qeso(i,k) = max(qeso(i,k), val ) @@ -2377,8 +2400,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! evef = edt(i) * evfact ! if(islimsk(i) == 1) evef=edt(i) * evfactl ! if(islimsk(i) == 1) evef=.07 - qcond(i) = shevf * evef * (q1(i,k) - qeso(i,k)) - & / (1. + el2orc * qeso(i,k) / t1(i,k)**2) + qcond(i) = shevf * evef * (new_q1(i,k) - qeso(i,k)) + & / (1. + el2orc * qeso(i,k) / new_t1(i,k)**2) dp = 1000. * del(i,k) factor = dp / grav if(rn(i) > 0. .and. qcond(i) < 0.) then @@ -2400,8 +2423,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & else rn(i) = rn(i) - tem1 endif - q1(i,k) = q1(i,k) + qevap(i) - t1(i,k) = t1(i,k) - elocp * qevap(i) + new_q1(i,k) = new_q1(i,k) + qevap(i) + new_t1(i,k) = new_t1(i,k) - elocp * qevap(i) deltv(i) = - elocp*qevap(i)/dt2 delq(i) = + qevap(i)/dt2 delqev(i) = delqev(i) + tem * qevap(i) @@ -2483,12 +2506,12 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! if (k > kb(i) .and. k <= ktcon(i)) then if (k >= kbcon(i) .and. k <= ktcon(i)) then tem = dellal(i,k) * xmb(i) * dt2 - tem1 = max(0.0, min(1.0, (tcr-t1(i,k))*tcrf)) - if (qtr(i,k,2) > -999.0) then - qtr(i,k,1) = qtr(i,k,1) + tem * tem1 ! ice - qtr(i,k,2) = qtr(i,k,2) + tem *(1.0-tem1) ! water + tem1 = max(0.0, min(1.0, (tcr-new_t1(i,k))*tcrf)) + if (new_qtr(i,k,2) > -999.0) then + new_qtr(i,k,1) = new_qtr(i,k,1) + tem * tem1 ! ice + new_qtr(i,k,2) = new_qtr(i,k,2) + tem *(1.0-tem1) ! water else - qtr(i,k,1) = qtr(i,k,1) + tem + new_qtr(i,k,1) = new_qtr(i,k,1) + tem endif endif endif @@ -2504,7 +2527,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! do k = 1, km ! do i = 1, im ! if(cnvflg(i) .and. rn(i) > 0.) then -! if (k <= kmax(i)) qtr(i,k,kk) = qaero(i,k,n) +! if (k <= kmax(i)) new_qtr(i,k,kk) = qaero(i,k,n) ! endif ! enddo ! enddo @@ -2544,14 +2567,14 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & if(cnvflg(i)) then if(k > kb(i) .and. k < ktop(i)) then tem = 0.5 * (eta(i,k-1) + eta(i,k)) * xmb(i) - tem1 = pfld(i,k) * 100. / (rd * t1(i,k)) + tem1 = pfld(i,k) * 100. / (rd * new_t1(i,k)) if(progsigma)then tem2 = sigmab(i) else tem2 = max(sigmagfm(i), betaw) endif ptem = tem / (tem2 * tem1) - qtr(i,k,ntk)=qtr(i,k,ntk)+0.5*tem2*ptem*ptem + new_qtr(i,k,ntk)=new_qtr(i,k,ntk)+0.5*tem2*ptem*ptem endif endif enddo @@ -2560,6 +2583,12 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif endif !! + ten_t = (new_t1 - t1)/delt + ten_u = (new_u1 - u1)/delt + ten_v = (new_v1 - v1)/delt + ten_q(:,:,1) = (new_q1 - q1)/delt + dqtr = (new_qtr - qtr)/delt + return end subroutine samfshalcnv_run !> @} diff --git a/physics/CONV/SAMF/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta index b96a742f2..f764f81b5 100644 --- a/physics/CONV/SAMF/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -55,6 +55,13 @@ dimensions = () type = integer intent = in +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in [first_time_step] standard_name = flag_for_first_timestep long_name = flag for first time step for time integration loop (cold/warmstart) @@ -265,7 +272,15 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in +[dqtr] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = out [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = specific_humidity_on_previous_timestep @@ -276,7 +291,7 @@ intent = in optional = True [q] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -284,37 +299,69 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = updated vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [t1] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [u1] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [v1] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [fscav] standard_name = chemical_tracer_scavenging_fractions long_name = array of aerosol scavenging coefficients @@ -492,7 +539,7 @@ type = logical intent = in [sigmain] - standard_name = prognostic_updraft_area_fraction_in_convection + standard_name = physics_timestep_initial_prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -501,7 +548,7 @@ intent = in optional = True [sigmaout] - standard_name = updraft_area_fraction_updated_by_physics + standard_name = updraft_area_fraction long_name = convective updraft area fraction updated by physics units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/SAS/sascnvn.meta b/physics/CONV/SAS/sascnvn.meta index b73dc5f47..4a2a7d554 100644 --- a/physics/CONV/SAS/sascnvn.meta +++ b/physics/CONV/SAS/sascnvn.meta @@ -207,7 +207,7 @@ kind = kind_phys intent = inout [q1] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -215,7 +215,7 @@ kind = kind_phys intent = inout [t1] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -223,7 +223,7 @@ kind = kind_phys intent = inout [u1] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -231,7 +231,7 @@ kind = kind_phys intent = inout [v1] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/SAS/shalcnv.meta b/physics/CONV/SAS/shalcnv.meta index 15324ed08..fb5a36b4b 100644 --- a/physics/CONV/SAS/shalcnv.meta +++ b/physics/CONV/SAS/shalcnv.meta @@ -221,7 +221,7 @@ kind = kind_phys intent = inout [q1] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -229,7 +229,7 @@ kind = kind_phys intent = inout [t1] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -237,7 +237,7 @@ kind = kind_phys intent = inout [u1] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -245,7 +245,7 @@ kind = kind_phys intent = inout [v1] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/nTiedtke/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 index 1de9de72b..2fca7092e 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke.F90 @@ -168,9 +168,9 @@ end subroutine cu_ntiedtke_init !! !================================================================================================================= ! level 1 subroutine 'cu_ntiedkte_run' - subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,ntqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & evap,hfx,zprecc,lmask,lq,km,dt,dx,kbot,ktop,kcnv, & - ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) + ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,ten_t,ten_u,ten_v,ten_q,dclw_i,dclw_l,errmsg,errflg) !================================================================================================================= ! this is the interface between the model and the mass flux convection module ! m.tiedtke e.c.m.w.f. 1989 @@ -200,7 +200,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, ! implicit none !--- input arguments: - integer, intent(in) :: lq, km, ktrac + integer, intent(in) :: ntqv, lq, km, ktrac integer, intent(in), dimension(:) :: lmask real(kind=kind_phys), intent(in) :: dt @@ -210,15 +210,18 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, real(kind=kind_phys), dimension(:,:),intent(in) :: pzz, prsi !--- inout arguments: - real(kind=kind_phys), dimension(:,:,:), intent(inout ) :: clw - real(kind=kind_phys), dimension(:,:), intent(inout) :: pu, pv, pt, pqv + real(kind=kind_phys), dimension(:,:,:), intent(in ) :: clw + real(kind=kind_phys), dimension(:,:), intent(in) :: pu, pv, pt, pqv !--- output arguments: real(kind=kind_phys), dimension(:), intent(out) :: zprecc integer, dimension(:), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf, dt_mf, cnvw, cnvc - + + real(kind=kind_phys), dimension (:,:), intent(out) :: ten_t, ten_u, ten_v, dclw_i, dclw_l + real(kind=kind_phys), dimension (:,:,:), intent(out) :: ten_q + ! error messages character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -248,6 +251,11 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 km1 = km + 1 ztmst=dt @@ -380,8 +388,8 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, if(pcte(j,k1).gt.0.) then fliq=foealfa(ztp1(j,k1)) fice=1.0-fliq - clw(j,k,2)=clw(j,k,2)+fliq*pcte(j,k1)*ztmst - clw(j,k,1)=clw(j,k,1)+fice*pcte(j,k1)*ztmst + dclw_l(j,k) = fliq*pcte(j,k1) + dclw_i(j,k) = fice*pcte(j,k1) endif end do end do @@ -389,8 +397,8 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, do k=1,km k1 = km-k+1 do j=1,lq - pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst - pqv(j,k) = zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst + ten_t(j,k) = ptte(j,k1)-ztt(j,k1) + ten_q(j,k,ntqv) = pqte(j,k1)-zqq(j,k1) ud_mf(j,k)= zmfu(j,k1)*ztmst dd_mf(j,k)= -zmfd(j,k1)*ztmst dt_mf(j,k)= zmfude_rate(j,k1)*ztmst @@ -417,8 +425,8 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, do k=1,km k1=km-k+1 do j=1,lq - pu(j,k)=pu(j,k)+pvom(j,k1)*ztmst - pv(j,k)=pv(j,k)+pvol(j,k1)*ztmst + ten_u(i,k) = pvom(j,k1) + ten_v(i,k) = pvol(j,k1) end do end do endif diff --git a/physics/CONV/nTiedtke/cu_ntiedtke.meta b/physics/CONV/nTiedtke/cu_ntiedtke.meta index 3e1755a5a..da8df2e7f 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke.meta @@ -70,39 +70,46 @@ name = cu_ntiedtke_run type = scheme [pu] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [pv] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [pt] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [pqv] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in [tdi] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -110,7 +117,7 @@ kind = kind_phys intent = in [qvdi] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -142,7 +149,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in [poz] standard_name = geopotential long_name = geopotential at model layer centers @@ -313,6 +320,54 @@ type = real kind = kind_phys intent = out +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[dclw_i] + standard_name = tendency_of_ice_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dclw_l] + standard_name = tendency_of_cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = tendency of ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/nTiedtke/cu_ntiedtke_post.meta b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta index 9960b6b77..d9a46efb9 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke_post.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta @@ -8,7 +8,7 @@ name = cu_ntiedtke_post_run type = scheme [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -16,7 +16,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta index 26392f0e6..3880fea1f 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta @@ -45,7 +45,7 @@ kind = kind_phys intent = in [t] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -53,7 +53,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/GWD/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 index beb7dbbc7..e06f4929a 100644 --- a/physics/GWD/cires_ugwp.F90 +++ b/physics/GWD/cires_ugwp.F90 @@ -60,7 +60,7 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: con_p0 integer, intent(in) :: gwd_opt logical, intent (in) :: do_ugwp - + character(len=*), intent (in) :: fn_nml2 !character(len=*), parameter :: fn_nml='input.nml' @@ -201,11 +201,11 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl, & dudt_ogw, dtauy2d_ms, dtaux2d_bl, dtauy2d_bl, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & - dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & + rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & con_omega, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & - ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) + ldiag3d, lssav, flag_for_gwd_generic_tend, ten_q, errmsg, errflg) implicit none @@ -245,8 +245,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr ! These arrays only allocated if ldiag_ugwp = .true. real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms - real(kind=kind_phys), intent(inout), dimension(:, :):: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, con_omega real(kind=kind_phys), intent(in), dimension(:) :: rain @@ -256,7 +254,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr logical, intent(in) :: lprnt integer, intent(in) :: ipr - + + real(kind=kind_phys), intent(out) :: ten_q(:,:,:) + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -278,6 +278,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ten_q = 0.0 ! 1) ORO stationary GWs ! ------------------ @@ -315,7 +317,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then - call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, ten_q, & ugrs, vgrs, tgrs, qgrs(:,:,1), & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & @@ -403,10 +405,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr gw_dudt(i,k) = pngw*gw_dudt(i,k) + pogw*Pdudt(i,k) gw_dvdt(i,k) = pngw*gw_dvdt(i,k) + pogw*Pdvdt(i,k) gw_kdis(i,k) = pngw*gw_kdis(i,k) + pogw*Pkdis(i,k) - ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB) - !dudt(i,k) = dudt(i,k) + gw_dudt(i,k) - !dvdt(i,k) = dvdt(i,k) + gw_dvdt(i,k) - !dtdt(i,k) = dtdt(i,k) + gw_dtdt(i,k) enddo enddo diff --git a/physics/GWD/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta index b0b1a8615..0ea14b6e4 100644 --- a/physics/GWD/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -509,24 +509,24 @@ kind = kind_phys intent = out [gw_dudt] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to UGWP + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to UGWP + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to UGWP + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -711,30 +711,6 @@ kind = kind_phys intent = inout optional = True -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rdxzb] standard_name = level_of_dividing_streamline long_name = level of the dividing streamline @@ -817,7 +793,7 @@ [q_tke] standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy - units = J + units = J kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -825,7 +801,7 @@ [dqdt_tke] standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy long_name = turbulent kinetic energy tendency due to model physics - units = J s-1 + units = J kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -916,6 +892,14 @@ dimensions = () type = logical intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GWD/cires_ugwp_post.F90 b/physics/GWD/cires_ugwp_post.F90 index f77bf5810..cc1313ec7 100644 --- a/physics/GWD/cires_ugwp_post.F90 +++ b/physics/GWD/cires_ugwp_post.F90 @@ -14,12 +14,12 @@ module cires_ugwp_post !! \htmlinclude cires_ugwp_post_run.html !! subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & - gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & + gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dudt_tms, & tot_zmtb, tot_zlwb, tot_zogw, & tot_tofd, tot_mtb, tot_ogw, tot_ngw, & du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & - dtdt, dudt, dvdt, errmsg, errflg) + errmsg, errflg) use machine, only: kind_phys @@ -34,10 +34,9 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_tms + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dudt, gw_dvdt, dudt_mtb, dudt_tms real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ogw real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -63,10 +62,6 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & dv3dt_ngw = dv3dt_ngw + dtf *gw_dvdt endif - dtdt = dtdt + gw_dtdt - dudt = dudt + gw_dudt - dvdt = dvdt + gw_dvdt - end subroutine cires_ugwp_post_run !> @} diff --git a/physics/GWD/cires_ugwp_post.meta b/physics/GWD/cires_ugwp_post.meta index 5d2a6a3d1..3a5a76b4b 100644 --- a/physics/GWD/cires_ugwp_post.meta +++ b/physics/GWD/cires_ugwp_post.meta @@ -36,25 +36,17 @@ dimensions = () type = integer intent = in -[gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to UGWP - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [gw_dudt] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to UGWP + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to UGWP + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -241,30 +233,6 @@ kind = kind_phys intent = inout optional = True -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - 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/GWD/drag_suite.F90 b/physics/GWD/drag_suite.F90 index 609074c4b..a9f217de1 100644 --- a/physics/GWD/drag_suite.F90 +++ b/physics/GWD/drag_suite.F90 @@ -203,7 +203,7 @@ end subroutine drag_suite_init !> \section det_drag_suite GFS Orographic GWD Scheme Detailed Algorithm !> @{ subroutine drag_suite_run( & - & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & IM,KM,dvdt,dudt,dtdt,dqdt,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & & var,oc1,oa4,ol4, & & varss,oc1ss,oa4ss,ol4ss, & @@ -335,9 +335,9 @@ subroutine drag_suite_run( & real(kind=kind_phys) :: rcl, cdmb real(kind=kind_phys) :: g_inv, rd_inv - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(out) :: & & dudt(:,:),dvdt(:,:), & - & dtdt(:,:) + & dtdt(:,:),dqdt(:,:,:) real(kind=kind_phys), intent(inout) :: rdxzb(:) real(kind=kind_phys), intent(in) :: & & u1(:,:),v1(:,:), & @@ -536,7 +536,12 @@ subroutine drag_suite_run( & udtend = -1 vdtend = -1 Tdtend = -1 - + + dudt(:,:) = 0. + dvdt(:,:) = 0. + dtdt(:,:) = 0. + dqdt(:,:,:)= 0. + if(ldiag3d) then udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) @@ -1548,7 +1553,7 @@ subroutine drag_suite_psl( & real(kind=kind_phys) :: rcl, cdmb real(kind=kind_phys) :: g_inv, g_cp, rd_inv - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(out) :: & & dudt(:,:),dvdt(:,:), & & dtdt(:,:) real(kind=kind_phys), intent(out) :: rdxzb(:) @@ -1758,7 +1763,11 @@ subroutine drag_suite_psl( & udtend = -1 vdtend = -1 Tdtend = -1 - + + dudt(:,:) = 0. + dvdt(:,:) = 0. + dtdt(:,:) = 0. + if(ldiag3d) then udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) diff --git a/physics/GWD/drag_suite.meta b/physics/GWD/drag_suite.meta index 559ea1a63..d2ebe7582 100644 --- a/physics/GWD/drag_suite.meta +++ b/physics/GWD/drag_suite.meta @@ -49,31 +49,39 @@ type = integer intent = in [dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out +[dqdt] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [u1] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -81,7 +89,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -89,7 +97,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -97,7 +105,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/GWD/gwdc.meta b/physics/GWD/gwdc.meta index 9884d8a62..a129783dd 100644 --- a/physics/GWD/gwdc.meta +++ b/physics/GWD/gwdc.meta @@ -57,7 +57,7 @@ type = integer intent = in [u1] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -65,7 +65,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -73,7 +73,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -81,7 +81,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/GWD/gwdc_post.meta b/physics/GWD/gwdc_post.meta index 6b3a160d0..5d78d513f 100644 --- a/physics/GWD/gwdc_post.meta +++ b/physics/GWD/gwdc_post.meta @@ -146,7 +146,7 @@ type = integer intent = in [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -154,7 +154,7 @@ kind = kind_phys intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -162,7 +162,7 @@ kind = kind_phys intent = inout [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/GWD/gwdc_pre.meta b/physics/GWD/gwdc_pre.meta index 55b0054bd..34ed823a1 100644 --- a/physics/GWD/gwdc_pre.meta +++ b/physics/GWD/gwdc_pre.meta @@ -92,7 +92,7 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/GWD/gwdps.f b/physics/GWD/gwdps.f index ca2efeef4..48bbee2cc 100644 --- a/physics/GWD/gwdps.f +++ b/physics/GWD/gwdps.f @@ -192,7 +192,7 @@ module gwdps !> \section det_gwdps GFS Orographic GWD Scheme Detailed Algorithm !> @{ subroutine gwdps_run( & - & IM,KM,A,B,C,U1,V1,T1,Q1,KPBL, & + & IM,KM,A,B,C,ten_q,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DELTIM,KDT, & & HPRIME,OC,OA4,CLX4,THETA,SIGMA,GAMMA,ELVMAX, & & DUSFC,DVSFC,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl, & @@ -301,8 +301,9 @@ subroutine gwdps_run( & integer, intent(in) :: KPBL(:) ! Index for the PBL top layer! real(kind=kind_phys), intent(in) :: & & deltim, G, CP, RD, RV, cdmbgwd(:) - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(out) :: & & A(:,:), B(:,:), C(:,:) + real(kind=kind_phys), intent(out) :: ten_q(:,:,:) real(kind=kind_phys), intent(in) :: & & U1(:,:), V1(:,:), T1(:,:), & & Q1(:,:), PRSI(:,:), DEL(:,:), & @@ -414,6 +415,11 @@ subroutine gwdps_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + A = 0.0 + B = 0.0 + C = 0.0 + ten_q = 0.0 ! ! parameter (cdmb = 1.0) ! non-dim sub grid mtn drag Amp (*j*) ! non-dim sub grid mtn drag Amp (*j*) @@ -1235,8 +1241,8 @@ subroutine gwdps_run( & if (K < IDXZB(I)) then ! --- lm mb (*j*) changes overwrite GWD ! --------------------------------------- DBIM = DB(I,K) / (1.+DB(I,K)*DELTIM) - A(J,K) = - DBIM * V1(J,K) + A(J,K) - B(J,K) = - DBIM * U1(J,K) + B(J,K) + A(J,K) = - DBIM * V1(J,K) + B(J,K) = - DBIM * U1(J,K) ENG1 = ENG0*(1.0-DBIM*DELTIM)*(1.0-DBIM*DELTIM) ! if ( ABS(DBIM * U1(J,K)) > .01 ) @@ -1255,8 +1261,8 @@ subroutine gwdps_run( & end if else ! orographic GWD applied ! ---------------------- - A(J,K) = DTAUY + A(J,K) - B(J,K) = DTAUX + B(J,K) + A(J,K) = DTAUY + B(J,K) = DTAUX tem1 = U1(J,K) + DTAUX*DELTIM tem2 = V1(J,K) + DTAUY*DELTIM ENG1 = 0.5 * (tem1*tem1+tem2*tem2) @@ -1270,7 +1276,7 @@ subroutine gwdps_run( & dvsfc_ms(j) = dvsfc_ms(j) + DTAUY * del(j,k) end if endif - C(J,K) = C(J,K) + max(ENG0-ENG1,0.) * oneocpdt + C(J,K) = max(ENG0-ENG1,0.) * oneocpdt ENDDO ENDDO diff --git a/physics/GWD/gwdps.meta b/physics/GWD/gwdps.meta index 58c18d367..6213e2010 100644 --- a/physics/GWD/gwdps.meta +++ b/physics/GWD/gwdps.meta @@ -22,29 +22,37 @@ type = integer intent = in [A] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [B] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [C] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [u1] standard_name = x_wind long_name = zonal wind diff --git a/physics/GWD/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f index f8b4ac6a6..b8e152df6 100644 --- a/physics/GWD/rayleigh_damp.f +++ b/physics/GWD/rayleigh_damp.f @@ -19,8 +19,8 @@ module rayleigh_damp !>\section gen_ray_damp_run GFS rayleigh_damp_runGeneral Algorithm !> @{ subroutine rayleigh_damp_run ( & - & lsidea,IM,KM,A,B,C,U1,V1,DT,CP,LEVR,pgr,PRSL,PRSLRD0,ral_ts, & - & ldiag3d,dtend,dtidx,index_of_process_rayleigh_damping, & + & lsidea,IM,KM,A,B,C,ten_q,U1,V1,DT,CP,LEVR,pgr,PRSL,PRSLRD0, & + & ral_ts,ldiag3d,dtend,dtidx,index_of_process_rayleigh_damping, & & index_of_temperature,index_of_x_wind,index_of_y_wind, & & errmsg,errflg) ! @@ -68,7 +68,8 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys),intent(in) :: DT, CP, PRSLRD0, ral_ts real(kind=kind_phys),intent(in) :: pgr(:), PRSL(:,:) real(kind=kind_phys),intent(in) :: U1(:,:), V1(:,:) - real(kind=kind_phys),intent(inout) :: A(:,:), B(:,:), C(:,:) + real(kind=kind_phys),intent( out) :: A(:,:), B(:,:), C(:,:) + real(kind=kind_phys),intent( out) :: ten_q(:,:,:) real(kind=kind_phys),optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: & @@ -81,9 +82,14 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys), parameter :: cons1=1.0, cons2=2.0, half=0.5 real(kind=kind_phys) DTAUX, DTAUY, wrk1, rtrd1, rfactrd, wrk2 &, ENG0, ENG1, tem1, tem2, dti, hfbcpdt, rtrd - real(kind=kind_phys) tx1(im), deltaA, deltaB, deltaC + real(kind=kind_phys) tx1(im) integer i, k, uidx,vidx,tidx - + + A = 0.0 + B = 0.0 + C = 0.0 + ten_q = 0.0 + if(ldiag3d) then uidx=dtidx(index_of_x_wind,index_of_process_rayleigh_damping) vidx=dtidx(index_of_y_wind,index_of_process_rayleigh_damping) @@ -125,20 +131,17 @@ subroutine rayleigh_damp_run ( & tem1 = U1(I,K) + DTAUX tem2 = V1(I,K) + DTAUY ENG1 = tem1*tem1 + tem2*tem2 - deltaA = DTAUY * dti - deltaB = DTAUX * dti - deltaC = max((ENG0-ENG1),0.0) * hfbcpdt - A(I,K) = A(I,K) + deltaA - B(I,K) = B(I,K) + deltaB - C(I,K) = C(I,K) + deltaC + A(I,K) = DTAUY * dti + B(I,K) = DTAUX * dti + C(I,K) = max((ENG0-ENG1),0.0) * hfbcpdt IF(vidx>=1) THEN - dtend(i,k,vidx) = dtend(i,k,vidx) + deltaA + dtend(i,k,vidx) = dtend(i,k,vidx) + A*dt ENDIF IF(uidx>=1) THEN - dtend(i,k,uidx) = dtend(i,k,uidx) + deltaB + dtend(i,k,uidx) = dtend(i,k,uidx) + B*dt ENDIF IF(tidx>=1) THEN - dtend(i,k,tidx) = dtend(i,k,tidx) + deltaC + dtend(i,k,tidx) = dtend(i,k,tidx) + C*dt ENDIF ENDDO ENDDO diff --git a/physics/GWD/rayleigh_damp.meta b/physics/GWD/rayleigh_damp.meta index 857c66e8b..e2e3a1abf 100644 --- a/physics/GWD/rayleigh_damp.meta +++ b/physics/GWD/rayleigh_damp.meta @@ -29,29 +29,37 @@ type = integer intent = in [A] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [B] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [C] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [u1] standard_name = x_wind long_name = zonal wind diff --git a/physics/GWD/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 index b9c56d6bf..e2608df3b 100644 --- a/physics/GWD/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -317,9 +317,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & dudt_oss, dvdt_oss, du_osscol, dv_osscol, & dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, & - dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & - tau_ogw, tau_ngw, tau_oss, & - zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & + dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, dqdt_gw, & + kdis_gw, tau_ogw, tau_ngw, tau_oss, & + zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, rdxzb, & dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & lprnt, ipr, spp_wts_gwd, spp_gwd, errmsg, errflg) @@ -429,12 +429,10 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_ngw, dvdt_ngw, kdis_ngw, dtdt_ngw real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, dtdt_gw, kdis_gw + real(kind=kind_phys), intent(out) , dimension(:,:,:) :: dqdt_gw real(kind=kind_phys), intent(out) , dimension(:) :: zogw, zlwb, zobl, zngw ! -! - real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: & @@ -516,7 +514,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! ngw+ogw - diag - dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0. + dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; dqdt_gw(:,:,:)=0. ; kdis_gw(:,:)=0. ! source fluxes tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0. @@ -571,7 +569,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) else - call drag_suite_run(im, levs, Pdvdt, Pdudt, Pdtdt, & + call drag_suite_run(im, levs, Pdvdt, Pdudt, Pdtdt, dqdt_gw, & ugrs,vgrs,tgrs,q1, & kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & @@ -769,12 +767,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dtdt_gw = Pdtdt kdis_gw = Pkdis end if -! -! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF) -! - dudt = dudt + dudt_gw - dvdt = dvdt + dvdt_gw - dtdt = dtdt + dtdt_gw end subroutine ugwpv1_gsldrag_run end module ugwpv1_gsldrag diff --git a/physics/GWD/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta index 24d8b0688..5cbecbbf1 100644 --- a/physics/GWD/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -949,29 +949,37 @@ kind = kind_phys intent = out [dudt_gw] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to all GWs + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [dvdt_gw] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to all GWs + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [dtdt_gw] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to all GWs + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out +[dqdt_gw] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [kdis_gw] standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag long_name = eddy mixing due to all GWs @@ -1053,30 +1061,6 @@ kind = kind_phys intent = out intent = out -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rdxzb] standard_name = level_of_dividing_streamline long_name = level of the dividing streamline diff --git a/physics/GWD/ugwpv1_gsldrag_post.F90 b/physics/GWD/ugwpv1_gsldrag_post.F90 index c57ce55f5..a5a161698 100644 --- a/physics/GWD/ugwpv1_gsldrag_post.F90 +++ b/physics/GWD/ugwpv1_gsldrag_post.F90 @@ -10,7 +10,7 @@ module ugwpv1_gsldrag_post !! \htmlinclude ugwpv1_gsldrag_post_run.html !! subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & - dtf, dudt_gw, dvdt_gw, dtdt_gw, & + dtf, dudt_gw, dvdt_gw, & tau_ogw, tau_ngw, zobl, zlwb, zogw, dudt_obl, dvdt_obl, & dudt_ofd, dvdt_ofd, dudt_ogw, dvdt_ogw, & dudt_oss, dvdt_oss, tot_zmtb, tot_zlwb, tot_zogw, & @@ -40,7 +40,7 @@ subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(:,:) :: dtdt_gw, dudt_gw, dvdt_gw + real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_gw, dvdt_gw real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_obl, dvdt_obl, dudt_ogw real(kind=kind_phys), intent(in), dimension(:,:), optional :: dvdt_ogw, dudt_ofd, dvdt_ofd real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_oss, dvdt_oss @@ -119,9 +119,6 @@ subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & !===================================================================== ! Updates inside the ugwpv1_gsldrag.F90 ! -! dtdt = dtdt + dtdt_gw -! dudt = dudt + dudt_gw -! dvdt = dvdt + dvdt_gw ! ! "post" may also create the "time-averaged" diagnostics" ! diff --git a/physics/GWD/ugwpv1_gsldrag_post.meta b/physics/GWD/ugwpv1_gsldrag_post.meta index b97db21c0..0bdfa4857 100644 --- a/physics/GWD/ugwpv1_gsldrag_post.meta +++ b/physics/GWD/ugwpv1_gsldrag_post.meta @@ -37,29 +37,21 @@ kind = kind_phys intent = in [dudt_gw] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to all GWs + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in [dvdt_gw] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to all GWs + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[dtdt_gw] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to all GWs - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [tau_ogw] standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag long_name = momentum flux or stress due to orographic gravity wave drag diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 05f9030a8..e8e0c3552 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -252,10 +252,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt br1,hpbl,vtype,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, & cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & - del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_dqdt, gw_kdis, & tau_tofd, tau_mtb, tau_ogw, tau_ngw, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & - dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & + rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldiag3d, dtend, dtidx, index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_orographic_gwd, & @@ -314,6 +314,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt real(kind=kind_phys), intent(out), dimension(:) :: rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis + real(kind=kind_phys), intent(out), dimension(:,:,:) :: gw_dqdt real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) @@ -326,8 +327,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt ! These arrays only allocated if ldiag_ugwp = .true. real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & con_rv, con_rerth, con_fvirt @@ -393,6 +392,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt gw_dudt(:,:) = 0.0 gw_dvdt(:,:) = 0.0 gw_dtdt(:,:) = 0.0 + gw_dqdt(:,:,:)= 0.0 gw_kdis(:,:) = 0.0 dudt_mtb(:,:) = 0.0 dudt_tms(:,:) = 0.0 @@ -454,7 +454,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt nmtvr_temp = nmtvr end if - call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, gw_dqdt, & ugrs, vgrs, tgrs, q1, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & @@ -508,9 +508,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then ! if (do_gwd_opt_psl) then - call drag_suite_psl(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & - tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & - kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + call drag_suite_psl(im,levs,gw_dvdt,gw_dudt,gw_dtdt,uwnd1, & + vwnd1,tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil, & + dtp,kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, & dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, & @@ -527,9 +527,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) else - call drag_suite_run(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & - tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & - kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + call drag_suite_run(im,levs,gw_dvdt,gw_dudt,gw_dtdt,gw_dqdt, & + uwnd1,vwnd1,tgrs,q1,kpbl,prsi,del,prsl,prslk,phii, & + phil,dtp,kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, & dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, & @@ -619,10 +619,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt gw_dudt(i,k) = gw_dudt(i,k)+ Pdudt(i,k) gw_dvdt(i,k) = gw_dvdt(i,k)+ Pdvdt(i,k) gw_kdis(i,k) = gw_kdis(i,k)+ Pkdis(i,k) - ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB) - !dudt(i,k) = dudt(i,k) +gw_dudt(i,k) - !dvdt(i,k) = dvdt(i,k) +gw_dvdt(i,k) - !dtdt(i,k) = dtdt(i,k) +gw_dtdt(i,k) enddo enddo diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index fe66b4b4b..7c38f074c 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -767,7 +767,7 @@ kind = kind_phys intent = in [ugrs] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -775,7 +775,7 @@ kind = kind_phys intent = in [vgrs] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -783,7 +783,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -791,7 +791,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -871,29 +871,37 @@ intent = out intent = out [gw_dudt] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to UGWP + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to UGWP + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to UGWP + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = out +[gw_dqdt] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [gw_kdis] standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag long_name = eddy mixing due to UGWP @@ -977,30 +985,6 @@ kind = kind_phys intent = inout optional = True -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rdxzb] standard_name = level_of_dividing_streamline long_name = level of the dividing streamline @@ -1089,9 +1073,9 @@ type = integer intent = in [q_tke] - standard_name = turbulent_kinetic_energy + standard_name = physics_timestep_initial_turbulent_kinetic_energy long_name = turbulent kinetic energy - units = J + units = J kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -1099,7 +1083,7 @@ [dqdt_tke] standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy long_name = turbulent kinetic energy tendency due to model physics - units = J s-1 + units = J kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GWD/unified_ugwp_post.F90 b/physics/GWD/unified_ugwp_post.F90 index 47ad40ba9..62f70c494 100644 --- a/physics/GWD/unified_ugwp_post.F90 +++ b/physics/GWD/unified_ugwp_post.F90 @@ -12,7 +12,7 @@ module unified_ugwp_post !! subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & dtf, im, levs, & - gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & + gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dvdt_ogw, & dudt_tms, tot_zmtb, tot_zlwb, tot_zogw, & tot_tofd, tot_mtb, tot_ogw, tot_ngw, & @@ -25,7 +25,7 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol, & dv_ofdcol, du3_ogwcol, dv3_ogwcol, du3_oblcol, dv3_oblcol, & du3_osscol, dv3_osscol, du3_ofdcol, dv3_ofdcol, & - dtdt, dudt, dvdt, errmsg, errflg) + errmsg, errflg) use machine, only: kind_phys @@ -41,7 +41,7 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dudt, gw_dvdt, dudt_mtb real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ogw, dvdt_ogw real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_tms real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw @@ -60,7 +60,6 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_oblcol, dv3_oblcol real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_osscol, dv3_osscol real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ofdcol, dv3_ofdcol - real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -107,10 +106,6 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & ldt3dt_ngw = ldt3dt_ngw + dtf *dtdt_ngw end if - dtdt = dtdt + gw_dtdt - dudt = dudt + gw_dudt - dvdt = dvdt + gw_dvdt - end subroutine unified_ugwp_post_run !> @} diff --git a/physics/GWD/unified_ugwp_post.meta b/physics/GWD/unified_ugwp_post.meta index d129b046f..179dc4b4f 100644 --- a/physics/GWD/unified_ugwp_post.meta +++ b/physics/GWD/unified_ugwp_post.meta @@ -43,25 +43,17 @@ dimensions = () type = integer intent = in -[gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to UGWP - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [gw_dudt] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to UGWP + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to UGWP + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -582,30 +574,6 @@ kind = kind_phys intent = inout optional = True -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - 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/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 index 62e5f4862..e32bb1ab0 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 @@ -8,30 +8,34 @@ module GFS_DCNV_generic_post !> \section arg_table_GFS_DCNV_generic_post_run Argument Table !! \htmlinclude GFS_DCNV_generic_post_run.html !! - subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & - cscnv, frain, rain1, dtf, cld1d, save_u, save_v, save_t, gu0, gv0, gt0, & - ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, nsamftrac, & + subroutine GFS_DCNV_generic_post_run (im, levs, tracers_total, otsptflag, & + imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_nssl, imp_physics_wsm6, imp_physics_mg, imp_physics_fer_hires, tend_opt_dcnv, lssav, ldiag3d, qdiag3d, ras, & + cscnv, frain, rain1, dtf, cld1d, gu0, gv0, gt0, ten_t, ten_u, ten_v, ten_q, & + dudt, dvdt, dtdt, dqdt, & + delt, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, nsamftrac, & rainc, cldwrk, upd_mf, dwn_mf, det_mf, dtend, dtidx, index_of_process_dcnv, & - index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntomega, & - ntrac,clw,satmedmf, trans_trac, errmsg, errflg) + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntomega, ntrac, & + clw, dclw, satmedmf, trans_trac, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, nsamftrac + integer, intent(in) :: im, levs, nsamftrac, tracers_total, tend_opt_dcnv + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_nssl, imp_physics_wsm6, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend + logical, dimension(:), intent(in) :: otsptflag real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(:), intent(in) :: rain1, cld1d - real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 - real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q + real(kind=kind_phys), dimension(:,:), intent(inout) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 real(kind=kind_phys), dimension(:,:), intent(in) :: dd_mf, dt_mf real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), intent(in) :: con_g @@ -48,7 +52,8 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, & ntsigma, ntomega, ntrac - real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw + real(kind=kind_phys), dimension(:,:,:), intent(in) :: dclw real(kind=kind_phys), dimension(:,:), intent(inout), optional :: cnvw_phy_f3d, cnvc_phy_f3d @@ -58,10 +63,143 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & integer :: i, k, n, idtend, tracers + real(kind=kind_phys), dimension(:,:), intent(in) :: ten_t, ten_u, ten_v + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: ten_q + real(kind=kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt, dtdt + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dqdt + real(kind=kind_phys), intent(in) :: delt + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + !ten_q(:,:,1) already has a value from the deep convection scheme + if (tracers_total > 0) then + tracers = 2 + do n=2,ntrac + if ( otsptflag(n) ) then + tracers = tracers + 1 + ten_q(1:im,:,n) = dclw(1:im,:,tracers) + endif + enddo + endif + if (ntcw > 0) then + if (imp_physics == imp_physics_zhao_carr .or. & + imp_physics == imp_physics_zhao_carr_pdf .or. & + imp_physics == imp_physics_gfdl) then + ten_q(1:im,:,ntcw) = dclw(1:im,:,1) + dclw(1:im,:,2) + elseif (ntiw > 0) then + ten_q(1:im,:,ntiw) = dclw(1:im,:,1) + ten_q(1:im,:,ntcw) = dclw(1:im,:,2) + else + ten_q(1:im,:,ntcw) = dclw(1:im,:,1) + dclw(1:im,:,2) + endif ! end if_ntiw + endif ! end if_ntcw + + + case_DCNV_ten: select case (tend_opt_dcnv) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*ten_t(i,k) + gu0(i,k) = gu0(i,k) + delt*ten_u(i,k) + gv0(i,k) = gv0(i,k) + delt*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + delt*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + delt*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_DCNV_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_DCNV_ten + + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + tracers = 2 + do n=2,ntrac +! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & +! n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & +! n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then + IF ( otsptflag(n) ) THEN + tracers = tracers + 1 + do k=1,levs + do i=1,im + clw(i,k,tracers) = gq0(i,k,n) + enddo + enddo + endif + enddo + endif ! end if_ras or cfscnv or samf + if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf) then ! zhao-carr microphysics + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntcw) + enddo + enddo + elseif (imp_physics == imp_physics_gfdl) then + clw(1:im,:,1) = gq0(1:im,:,ntcw) + elseif (imp_physics == imp_physics_thompson) then + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + enddo + enddo + else if (imp_physics == imp_physics_nssl ) then + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! cloud ice + clw(i,k,2) = gq0(i,k,ntcw) ! cloud droplets + enddo + enddo + elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires) then + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + enddo + enddo + endif + + !shallow convection expects clw has already been updated + if (.not. ras .and. .not. cscnv) then if (npdf3d == 3 .and. num_p3d == 4) then do k=1,levs @@ -94,17 +232,17 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & if (ldiag3d .and. flag_for_dcnv_generic_tend) then idtend=dtidx(index_of_temperature,index_of_process_dcnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0-save_t)*frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_t * delt)*frain endif idtend=dtidx(index_of_x_wind,index_of_process_dcnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0-save_u)*frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_u * delt)*frain endif idtend=dtidx(index_of_y_wind,index_of_process_dcnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_v * delt)*frain endif if (cscnv .or. satmedmf .or. trans_trac .or. ras) then @@ -119,7 +257,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & tracers = tracers + 1 idtend = dtidx(100+n,index_of_process_dcnv) if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-save_q(:,:,n) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,n)*delt) * frain endif endif enddo @@ -127,13 +265,13 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & do n=2,ntrac idtend = dtidx(100+n,index_of_process_dcnv) if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,n)*delt)*frain endif enddo endif idtend = dtidx(100+ntqv, index_of_process_dcnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,ntqv)*delt) * frain endif ! convective mass fluxes diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta index 1498afa53..01cbad27f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta @@ -22,6 +22,90 @@ dimensions = () type = integer intent = in +[tracers_total] + standard_name = number_of_total_tracers + long_name = total number of tracers + units = count + dimensions = () + type = integer + intent = in +[otsptflag] + standard_name = flag_convective_tracer_transport_interstitial + long_name = flag for interstitial tracer transport + units = flag + dimensions = (number_of_tracers) + type = logical + intent = in +[imp_physics] + standard_name = control_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_gfdl] + standard_name = identifier_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_thompson] + standard_name = identifier_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_zhao_carr] + standard_name = identifier_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_zhao_carr_pdf] + standard_name = identifier_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_nssl] + standard_name = identifier_for_nssl_microphysics_scheme + long_name = choice of NSSL 2-moment microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_wsm6] + standard_name = identifier_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_mg] + standard_name = identifier_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_fer_hires] + standard_name = identifier_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[tend_opt_dcnv] + standard_name = control_for_application_method_of_deep_convection_tendencies + long_name = control for application method of deep convection tendencies + units = 1 + dimensions = () + type = integer + intent = in [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics @@ -82,54 +166,94 @@ type = real kind = kind_phys intent = in -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme + intent = inout +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme + intent = inout +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics - units = m s-1 + intent = inout +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics - units = m s-1 +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt @@ -207,18 +331,18 @@ type = integer intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + intent = inout +[delt] + standard_name = timestep_for_physics + long_name = physics time step + units = s + dimensions = () type = real kind = kind_phys intent = in @@ -496,6 +620,14 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys + intent = inout +[dclw] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys intent = in [ntrac] standard_name = number_of_tracers diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 deleted file mode 100644 index 7bb47ac9b..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 +++ /dev/null @@ -1,93 +0,0 @@ -!> \file GFS_DCNV_generic_pre.F90 -!! Contains code related to deep convective schemes to be used within the GFS physics suite. - - module GFS_DCNV_generic_pre - - contains - -!> \brief Interstitial scheme called prior to any deep convective scheme to save state variables for calculating tendencies after the deep convective scheme is executed -!! \section arg_table_GFS_DCNV_generic_pre_run Argument Table -!! \htmlinclude GFS_DCNV_generic_pre_run.html -!! - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm, & - gu0, gv0, gt0, gq0, nsamftrac, ntqv, & - save_u, save_v, save_t, save_q, clw, & - ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, & - ntrz, ntgz, nthz, ntsigma, ntomega, & - cscnv, satmedmf, trans_trac, ras, ntrac, & - dtidx, index_of_process_dcnv, errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), & - ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv, & - ntrz, ntgz, nthz, ntsigma, ntomega - logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 - real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0 - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_v - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - logical, intent(in) :: cscnv, satmedmf, trans_trac, ras - real(kind=kind_phys), parameter :: zero = 0.0d0 - real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw - - integer :: i, k, n, tracers - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (ldiag3d) then - do k=1,levs - do i=1,im - save_t(i,k) = gt0(i,k) - save_u(i,k) = gu0(i,k) - save_v(i,k) = gv0(i,k) - enddo - enddo - elseif (do_cnvgwd) then - do k=1,levs - do i=1,im - save_t(i,k) = gt0(i,k) - enddo - enddo - endif - - if ((ldiag3d.and.qdiag3d) .or. cplchm) then - if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - tracers = 2 - do n=2,ntrac - if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & - n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & - n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & - n /= nthl .and. n /= nthnc .and. n /= nthv .and. & - n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & - n /= ntgv .and. n/= ntsigma .and. n /= ntomega) then - tracers = tracers + 1 - if(dtidx(100+n,index_of_process_dcnv)>0) then - save_q(:,:,n) = clw(:,:,tracers) - endif - endif - enddo - else - do n=2,ntrac - if(dtidx(100+n,index_of_process_dcnv)>0) then - save_q(:,:,n) = gq0(:,:,n) - endif - enddo - endif ! end if_ras or cfscnv or samf - save_q(:,:,ntqv) = gq0(:,:,ntqv) - endif - - end subroutine GFS_DCNV_generic_pre_run - - end module GFS_DCNV_generic_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta deleted file mode 100644 index 15fb106e7..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta +++ /dev/null @@ -1,327 +0,0 @@ -[ccpp-table-properties] - name = GFS_DCNV_generic_pre - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = GFS_DCNV_generic_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_layer_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[do_cnvgwd] - standard_name = flag_for_convective_gravity_wave_drag - long_name = flag for convective gravity wave drag (gwd) - units = flag - dimensions = () - type = logical - intent = in -[cplchm] - standard_name = flag_for_chemistry_coupling - long_name = flag controlling cplchm collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0] - standard_name = tracer_concentration_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout -[nsamftrac] - standard_name = number_of_tracers_for_samf - long_name = number of tracers for scale-aware mass flux schemes - units = count - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[cscnv] - standard_name = flag_for_Chikira_Sugiyama_deep_convection - long_name = flag for Chikira-Sugiyama convection - units = flag - dimensions = () - type = logical - intent = in -[satmedmf] - standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL - long_name = flag for scale-aware TKE moist EDMF PBL scheme - units = flag - dimensions = () - type = logical - intent = in -[trans_trac] - standard_name = flag_for_convective_transport_of_tracers - long_name = flag for convective transport of tracers - units = flag - dimensions = () - type = logical - intent = in -[ras] - standard_name = flag_for_relaxed_arakawa_schubert_deep_convection - long_name = flag for ras convection scheme - units = flag - dimensions = () - type = logical - intent = in -[ntsigma] - standard_name = index_of_updraft_area_fraction_in_tracer_concentration_array - long_name = tracer index of updraft_area_fraction - units = index - dimensions = () - type = integer - intent = in -[ntomega] - standard_name = index_of_updraft_velocity_in_tracer_concentration_array - long_name = tracer index of updraft_velocity - units = index - dimensions = () - type = integer - intent = in -[ntcw] - standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in -[ntiw] - standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in -[ntclamt] - standard_name = index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array - long_name = tracer index for cloud amount integer - units = index - dimensions = () - type = integer - intent = in -[ntrw] - standard_name = index_of_rain_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for rain water - units = index - dimensions = () - type = integer - intent = in -[ntsw] - standard_name = index_of_snow_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for snow water - units = index - dimensions = () - type = integer - intent = in -[ntrnc] - standard_name = index_of_mass_number_concentration_of_rain_in_tracer_concentration_array - long_name = tracer index for rain number concentration - units = index - dimensions = () - type = integer - intent = in -[ntsnc] - standard_name = index_of_mass_number_concentration_of_snow_in_tracer_concentration_array - long_name = tracer index for snow number concentration - units = index - dimensions = () - type = integer - intent = in -[ntgl] - standard_name = index_of_graupel_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for graupel - units = index - dimensions = () - type = integer - intent = in -[ntgnc] - standard_name = index_of_mass_number_concentration_of_graupel_in_tracer_concentration_array - long_name = tracer index for graupel number concentration - units = index - dimensions = () - type = integer - intent = in -[nthl] - standard_name = index_of_hail_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for hail - units = index - dimensions = () - type = integer - intent = in -[nthnc] - standard_name = index_of_mass_number_concentration_of_hail_in_tracer_concentration_array - long_name = tracer index for hail number concentration - units = index - dimensions = () - type = integer - intent = in -[ntgv] - standard_name = index_of_graupel_volume_in_tracer_concentration_array - long_name = tracer index for graupel particle volume - units = index - dimensions = () - type = integer - intent = in -[nthv] - standard_name = index_of_hail_volume_in_tracer_concentration_array - long_name = tracer index for hail particle volume - units = index - dimensions = () - type = integer - intent = in -[ntrz] - standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array - long_name = tracer index for rain reflectivity - units = index - dimensions = () - type = integer - intent = in -[ntgz] - standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array - long_name = tracer index for graupel reflectivity - units = index - dimensions = () - type = integer - intent = in -[nthz] - standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array - long_name = tracer index for hail reflectivity - units = index - dimensions = () - type = integer - intent = in -[clw] - standard_name = convective_transportable_tracers - long_name = array to contain cloud water and other convective trans. tracers - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) - type = real - kind = kind_phys - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 index 579d32fac..2d8b9534a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 @@ -11,18 +11,24 @@ module GFS_GWD_generic_post !! \section general General Algorithm !! \section detailed Detailed Algorithm !> @{ - subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & - & dugwd, dvgwd, flag_for_gwd_generic_tend, dtend, dtidx, index_of_temperature, index_of_x_wind, & + subroutine GFS_GWD_generic_post_run(im, levs, ntrac, tend_opt_gwd, lssav, ldiag3d, dtf, dtp, dusfcg, dvsfcg, ten_t, ten_u, ten_v, ten_q, dudt, dvdt, dtdt, dqdt, & + & dugwd, dvgwd, gt0, gq0, gu0, gv0, flag_for_gwd_generic_tend, dtend, dtidx, index_of_temperature, index_of_x_wind, & & index_of_y_wind, index_of_process_orographic_gwd, errmsg, errflg) use machine, only : kind_phys implicit none + integer, intent(in) :: im, levs, ntrac, tend_opt_gwd logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dusfcg(:), dvsfcg(:) - real(kind=kind_phys), intent(in) :: dudt(:,:), dvdt(:,:), dtdt(:,:) - real(kind=kind_phys), intent(in) :: dtf + real(kind=kind_phys), intent(in) :: ten_t(:,:), ten_u(:,:), ten_v(:,:) + real(kind=kind_phys), intent(in) :: ten_q(:,:,:) + real(kind=kind_phys), intent(inout) :: dudt(:,:), dvdt(:,:), dtdt(:,:) + real(kind=kind_phys), intent(inout) :: dqdt(:,:,:) + real(kind=kind_phys), intent(inout) :: gt0(:,:), gv0(:,:), gu0(:,:) + real(kind=kind_phys), intent(inout) :: gq0(:,:,:) + real(kind=kind_phys), intent(in) :: dtf, dtp real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) @@ -34,12 +40,66 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: idtend + integer :: i,k,n,idtend ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + case_GWD_ten: select case (tend_opt_gwd) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*ten_t(i,k) + gu0(i,k) = gu0(i,k) + dtp*ten_u(i,k) + gv0(i,k) = gv0(i,k) + dtp*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + dtp*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + dtp*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_GWD_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_GWD_ten + if (lssav) then dugwd(:) = dugwd(:) + dusfcg(:)*dtf dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf @@ -47,17 +107,17 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d if (ldiag3d .and. flag_for_gwd_generic_tend) then idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt*dtf + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_t*dtf endif idtend = dtidx(index_of_x_wind, index_of_process_orographic_gwd) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dudt*dtf + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_u*dtf endif idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt*dtf + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_v*dtf endif endif endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta index a11b8641d..fbc41f7a3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta @@ -8,6 +8,34 @@ [ccpp-arg-table] name = GFS_GWD_generic_post_run type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in +[tend_opt_gwd] + standard_name = control_for_application_method_of_gravity_wave_drag_tendencies + long_name = control for application method of gravity wave drag tendencies + units = 1 + dimensions = () + type = integer + intent = in [lssav] standard_name = flag_for_diagnostics long_name = flag for calculating diagnostic fields @@ -30,6 +58,14 @@ type = real kind = kind_phys intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [dusfcg] standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag @@ -46,6 +82,38 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = zonal wind tendency due to model physics @@ -53,7 +121,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [dvdt] standard_name = process_split_cumulative_tendency_of_y_wind long_name = meridional wind tendency due to model physics @@ -61,7 +129,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics @@ -69,7 +137,15 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [dugwd] standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag long_name = integral over time of zonal stress due to gravity wave drag @@ -86,6 +162,38 @@ type = real kind = kind_phys intent = inout +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 index f0d708d5b..ba80e62f0 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 @@ -13,11 +13,8 @@ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & - & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtend, dtidx, index_of_temperature, index_of_x_wind, & - & index_of_y_wind, index_of_process_orographic_gwd, & - & dudt, dvdt, dtdt, dtf, & - & flag_for_gwd_generic_tend, errmsg, errflg) + & sigma, gamma, elvmax, & + & errmsg, errflg) use machine, only : kind_phys implicit none @@ -30,18 +27,11 @@ subroutine GFS_GWD_generic_pre_run( & & theta(:), sigma(:), gamma(:), elvmax(:) real(kind=kind_phys), intent(out), optional :: & & varss(:), ocss(:), oa4ss(:,:), clxss(:,:) - logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend - real(kind=kind_phys), intent(in) :: dtdt(:,:), dudt(:,:), dvdt(:,:) - ! dtend only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_temperature, & - & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd - real(kind=kind_phys), intent(in) :: dtf character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k, idtend + integer :: i, k ! Initialize CCPP error handling variables errmsg = '' @@ -115,23 +105,6 @@ subroutine GFS_GWD_generic_pre_run( & elvmax = 0 endif ! end if_nmtvr - if (lssav .and. ldiag3d .and. flag_for_gwd_generic_tend) then - idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) - dtdt*dtf - endif - - idtend = dtidx(index_of_x_wind, index_of_process_orographic_gwd) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) - dudt*dtf - endif - - idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) - dvdt*dtf - endif - endif - end subroutine GFS_GWD_generic_pre_run end module GFS_GWD_generic_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta index 8321c7d32..88ff7822f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta @@ -128,103 +128,6 @@ type = real kind = kind_phys intent = out -[lssav] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - intent = inout - optional = True -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[dtf] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[flag_for_gwd_generic_tend] - standard_name = flag_for_generic_tendency_due_to_gravity_wave_drag - long_name = true if GFS_GWD_generic should calculate tendencies - units = flag - dimensions = () - type = logical - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 index 97d9b138d..8df66f16d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 @@ -16,11 +16,12 @@ module GFS_MP_generic_post !! \htmlinclude GFS_MP_generic_post_run.html !! subroutine GFS_MP_generic_post_run( & - im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_tempo, & - imp_physics_nssl, imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, & - rhowater, rainmin, dtf, frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, & - refl_10cm, imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, & - save_q, rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, & + im, levs, kdt, tend_opt_mp, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, & + imp_physics_tempo, imp_physics_nssl, imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, & + progsigma, con_g, rhowater, rainmin, dtf, frain, rainc, rain1, rann, xlat, xlon, ten_t, ten_u, ten_v, ten_q, dudt,& + dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, & + refl_10cm, imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, & + rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, & cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & snow_cpl, pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & @@ -33,7 +34,7 @@ subroutine GFS_MP_generic_post_run( use calpreciptype_mod, only: calpreciptype implicit none - integer, intent(in) :: im, levs, kdt, nrcm, nncl, ntcw, ntrac, num_dfi_radar, index_of_process_dfi_radar + integer, intent(in) :: im, levs, kdt, tend_opt_mp, nrcm, nncl, ntcw, ntrac, num_dfi_radar, index_of_process_dfi_radar integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm, imp_physics_tempo logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden @@ -43,16 +44,20 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) integer, intent(in) :: ix_dfi_radar(:) - real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm + real(kind=kind_phys), dimension(:,:), intent(in) :: ten_u, ten_v, ten_t + real(kind=kind_phys), dimension(:,:,:), intent(in) :: ten_q + real(kind=kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt, dtdt + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dqdt + real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,gu0,gv0,refl_10cm real(kind=kind_phys), intent(in) :: dtf, frain, con_g, rainmin, rhowater real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(:), intent(inout) :: ice, snow, graupel, rainc real(kind=kind_phys), dimension(:), intent(in), optional :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann - real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, save_t, del + real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, del real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii,phil - real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 real(kind=kind_phys), dimension(:,:,:), intent(in), optional :: dfi_radar_tten @@ -101,11 +106,12 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys ! *DH - integer :: i, k, ic, itrac, idtend, itime, idtend_radar, idtend_mp + integer :: i, k, n, ic, itrac, idtend, itime, idtend_radar, idtend_mp real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2, ttend real(kind=kind_phys), dimension(im) :: domr, domzr, domip, doms, t850, work1 + real(kind=kind_phys), dimension(im,levs) :: save_t real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice @@ -124,9 +130,66 @@ subroutine GFS_MP_generic_post_run( ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + onebg = one/con_g + save_t = gt0 !save temperature before tendency application in case + !the temperature tendency application is overwritten by radar tendencies below + + case_MP_ten: select case (tend_opt_mp) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*ten_t(i,k) + gu0(i,k) = gu0(i,k) + dtp*ten_u(i,k) + gv0(i,k) = gv0(i,k) + dtp*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + dtp*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + dtp*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_MP_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_MP_ten + do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo @@ -482,7 +545,7 @@ subroutine GFS_MP_generic_post_run( if(idtend>=1) then do k=1,levs do i=1,im - dtend(i,k,idtend) = dtend(i,k,idtend) + (gq0(i,k,itrac)-save_q(i,k,itrac)) * frain + dtend(i,k,idtend) = dtend(i,k,idtend) + ten_q(i,k,itrac)*dtp*frain enddo enddo endif @@ -495,7 +558,7 @@ subroutine GFS_MP_generic_post_run( if(progsigma)then do k=1,levs do i=1,im - dqdt_qmicro(i,k)=(gq0(i,k,1)-save_q(i,k,1))/dtp + dqdt_qmicro(i,k)=ten_q(i,k,1) enddo enddo endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta index 15ad5f6b3..e8b746f8e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta @@ -29,6 +29,13 @@ dimensions = () type = integer intent = in +[tend_opt_mp] + standard_name = control_for_application_method_of_microphysics_tendencies + long_name = control for application method of microphysics tendencies + units = 1 + dimensions = () + type = integer + intent = in [rainmin] standard_name = lwe_thickness_of_minimum_rain_amount long_name = minimum rain amount @@ -221,22 +228,102 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in + intent = inout [prsl] standard_name = air_pressure long_name = layer mean pressure @@ -422,22 +509,6 @@ dimensions = () type = logical intent = in -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in [rain0] standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain on physics timestep diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 deleted file mode 100644 index 32b097e1d..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 +++ /dev/null @@ -1,62 +0,0 @@ -!> \file GFS_MP_generic_pre.F90 -!! This file contains the subroutines that calculate diagnotics variables -!! before calling any microphysics scheme: - -!> This module contains the CCPP-compliant MP generic pre interstitial codes. - module GFS_MP_generic_pre - contains - -!> \section arg_table_GFS_MP_generic_pre_run Argument Table -!! \htmlinclude GFS_MP_generic_pre_run.html -!! - subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, progsigma, ntcw, nncl, & - ntrac, gt0, gq0, save_t, save_q, num_dfi_radar, errmsg, errflg) -! - use machine, only: kind_phys - - implicit none - integer, intent(in) :: im, levs, ntcw, nncl, ntrac, num_dfi_radar - logical, intent(in) :: ldiag3d, qdiag3d, do_aw, progsigma - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0 - real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0 - - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k, n - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (ldiag3d .or. do_aw .or. num_dfi_radar>0) then - do k=1,levs - do i=1,im - save_t(i,k) = gt0(i,k) - enddo - enddo - endif - if (ldiag3d .or. do_aw .or. progsigma) then - if(qdiag3d) then - do n=1,ntrac - do k=1,levs - do i=1,im - save_q(i,k,n) = gq0(i,k,n) - enddo - enddo - enddo - else if(do_aw .or. progsigma) then - ! if qdiag3d, all q are saved already - save_q(1:im,:,1) = gq0(1:im,:,1) - do n=ntcw,ntcw+nncl-1 - save_q(1:im,:,n) = gq0(1:im,:,n) - enddo - endif - endif - - end subroutine GFS_MP_generic_pre_run - - end module GFS_MP_generic_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta deleted file mode 100644 index 6d5fd1538..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta +++ /dev/null @@ -1,126 +0,0 @@ -[ccpp-table-properties] - name = GFS_MP_generic_pre - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = GFS_MP_generic_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_layer_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = logical flag for 3D diagnostics - units = flag - dimensions = () - type = logical - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = logical flag for 3D tracer diagnostics - units = flag - dimensions = () - type = logical - intent = in -[do_aw] - standard_name = flag_for_Arakawa_Wu_adjustment - long_name = flag for Arakawa Wu scale-aware adjustment - units = flag - dimensions = () - type = logical - intent = in -[progsigma] - standard_name = do_prognostic_updraft_area_fraction - long_name = flag for prognostic area fraction in cumulus convection - units = flag - dimensions = () - type = logical - intent = in -[ntcw] - standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in -[nncl] - standard_name = number_of_condensate_species - long_name = number of cloud condensate types - units = count - dimensions = () - type = integer - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0] - standard_name = tracer_concentration_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout -[num_dfi_radar] - standard_name = number_of_radar_derived_temperature_or_convection_suppression_intervals - long_name = number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 index 01033f4d6..51c91e965 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 @@ -10,17 +10,18 @@ module GFS_PBL_generic_post !! subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev,nqrimef, & - trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & + tend_opt_pbl, trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, mraerosol, nssl_hail_on, nssl_3moment, & cplflx, cplaqm, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, & - shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & + shinhong, do_ysu, dvdftra, ten_t, ten_u, ten_v, ten_q, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dtp, dudt, dvdt, dtdt, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & index_of_process_pbl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, & dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, & rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, kdt, dusfc_cice, dvsfc_cice, & dtsfc_cice, dqsfc_cice, use_med_flux, dtsfc_med, dqsfc_med, dusfc_med, dvsfc_med, wet, dry, icy, wind, stress_wat, & - hflx_wat, evap_wat, ugrs1, vgrs1, hffac, ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, huge, errmsg, errflg) + hflx_wat, evap_wat, ugrs1, vgrs1, hffac, ugrs, vgrs, tgrs, qgrs, huge, & + gt0, gq0, gu0, gv0, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -31,6 +32,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm, kdt integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz + integer, intent(in) :: tend_opt_pbl logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires @@ -40,10 +42,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu logical, intent(in) :: flag_for_pbl_generic_tend - real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t - real(kind=kind_phys), dimension(:,:, :), intent(in) :: save_q - real(kind=kind_phys), intent(in) :: dtf + real(kind=kind_phys), intent(in) :: dtf, dtp real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap, huge real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac real(kind=kind_phys), dimension(:,:), intent(in) :: prsl @@ -55,10 +55,13 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs real(kind=kind_phys), dimension(:,:, :), intent(in) :: dvdftra - real(kind=kind_phys), dimension(:), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu - real(kind=kind_phys), dimension(:,:), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw - + real(kind=kind_phys), dimension(:,:), intent(in) :: ten_t, ten_u, ten_v + real(kind=kind_phys), dimension(:,:,:), intent(out) :: ten_q + real(kind=kind_phys), dimension(:), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1 + real(kind=kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt, dtdt real(kind=kind_phys), dimension(:,:, :), intent(inout) :: dqdt + real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0, gv0, gu0 + real(kind=kind_phys), dimension(:,:, :), intent(inout) :: gq0 ! The following arrays may not be allocated, depending on certain flags (cplflx, ...). ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, @@ -91,15 +94,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ten_q = 0.0 !GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then - dqdt = dvdftra + ten_q = dvdftra elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then ! if (ntke>0) then do k=1,levs do i=1,im - dqdt(i,k,ntke) = dvdftra(i,k,ntkev) + ten_q(i,k,ntke) = dvdftra(i,k,ntkev) enddo enddo endif @@ -119,7 +123,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, k1 = k1 + 1 do k=1,levs do i=1,im - dqdt(i,k,n) = dvdftra(i,k,k1) + ten_q(i,k,n) = dvdftra(i,k,k1) enddo enddo enddo @@ -129,10 +133,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! WSM6 do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntoz) = dvdftra(i,k,4) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntoz) = dvdftra(i,k,4) enddo enddo @@ -140,12 +144,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Ferrier-Aligo do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,nqrimef) = dvdftra(i,k,5) - dqdt(i,k,ntoz) = dvdftra(i,k,6) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,nqrimef) = dvdftra(i,k,5) + ten_q(i,k,ntoz) = dvdftra(i,k,6) enddo enddo @@ -154,47 +158,47 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if(ltaerosol) then do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntlnc) = dvdftra(i,k,7) - dqdt(i,k,ntinc) = dvdftra(i,k,8) - dqdt(i,k,ntrnc) = dvdftra(i,k,9) - dqdt(i,k,ntoz) = dvdftra(i,k,10) - dqdt(i,k,ntwa) = dvdftra(i,k,11) - dqdt(i,k,ntia) = dvdftra(i,k,12) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntlnc) = dvdftra(i,k,7) + ten_q(i,k,ntinc) = dvdftra(i,k,8) + ten_q(i,k,ntrnc) = dvdftra(i,k,9) + ten_q(i,k,ntoz) = dvdftra(i,k,10) + ten_q(i,k,ntwa) = dvdftra(i,k,11) + ten_q(i,k,ntia) = dvdftra(i,k,12) enddo enddo else if(mraerosol) then do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntlnc) = dvdftra(i,k,7) - dqdt(i,k,ntinc) = dvdftra(i,k,8) - dqdt(i,k,ntrnc) = dvdftra(i,k,9) - dqdt(i,k,ntoz) = dvdftra(i,k,10) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntlnc) = dvdftra(i,k,7) + ten_q(i,k,ntinc) = dvdftra(i,k,8) + ten_q(i,k,ntrnc) = dvdftra(i,k,9) + ten_q(i,k,ntoz) = dvdftra(i,k,10) enddo enddo else do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntinc) = dvdftra(i,k,7) - dqdt(i,k,ntrnc) = dvdftra(i,k,8) - dqdt(i,k,ntoz) = dvdftra(i,k,9) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntinc) = dvdftra(i,k,7) + ten_q(i,k,ntrnc) = dvdftra(i,k,8) + ten_q(i,k,ntoz) = dvdftra(i,k,9) enddo enddo endif @@ -202,54 +206,54 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (ntgl > 0) then ! MG do k=1,levs do i=1,im - dqdt(i,k,1) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntlnc) = dvdftra(i,k,7) - dqdt(i,k,ntinc) = dvdftra(i,k,8) - dqdt(i,k,ntrnc) = dvdftra(i,k,9) - dqdt(i,k,ntsnc) = dvdftra(i,k,10) - dqdt(i,k,ntgnc) = dvdftra(i,k,11) - dqdt(i,k,ntoz) = dvdftra(i,k,12) + ten_q(i,k,1) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntlnc) = dvdftra(i,k,7) + ten_q(i,k,ntinc) = dvdftra(i,k,8) + ten_q(i,k,ntrnc) = dvdftra(i,k,9) + ten_q(i,k,ntsnc) = dvdftra(i,k,10) + ten_q(i,k,ntgnc) = dvdftra(i,k,11) + ten_q(i,k,ntoz) = dvdftra(i,k,12) enddo enddo else ! MG2 do k=1,levs do i=1,im - dqdt(i,k,1) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntlnc) = dvdftra(i,k,6) - dqdt(i,k,ntinc) = dvdftra(i,k,7) - dqdt(i,k,ntrnc) = dvdftra(i,k,8) - dqdt(i,k,ntsnc) = dvdftra(i,k,9) - dqdt(i,k,ntoz) = dvdftra(i,k,10) + ten_q(i,k,1) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntlnc) = dvdftra(i,k,6) + ten_q(i,k,ntinc) = dvdftra(i,k,7) + ten_q(i,k,ntrnc) = dvdftra(i,k,8) + ten_q(i,k,ntsnc) = dvdftra(i,k,9) + ten_q(i,k,ntoz) = dvdftra(i,k,10) enddo enddo endif elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntoz) = dvdftra(i,k,7) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntoz) = dvdftra(i,k,7) enddo enddo elseif (imp_physics == imp_physics_zhao_carr) then do k=1,levs do i=1,im - dqdt(i,k,1) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntoz) = dvdftra(i,k,3) + ten_q(i,k,1) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntoz) = dvdftra(i,k,3) enddo enddo elseif (imp_physics == imp_physics_nssl ) then @@ -257,31 +261,31 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, IF ( nssl_hail_on ) THEN do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,nthl) = dvdftra(i,k,7) - dqdt(i,k,ntlnc) = dvdftra(i,k,8) - dqdt(i,k,ntinc) = dvdftra(i,k,9) - dqdt(i,k,ntrnc) = dvdftra(i,k,10) - dqdt(i,k,ntsnc) = dvdftra(i,k,11) - dqdt(i,k,ntgnc) = dvdftra(i,k,12) - dqdt(i,k,nthnc) = dvdftra(i,k,13) - dqdt(i,k,ntgv) = dvdftra(i,k,14) - dqdt(i,k,nthv) = dvdftra(i,k,15) - dqdt(i,k,ntoz) = dvdftra(i,k,16) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,nthl) = dvdftra(i,k,7) + ten_q(i,k,ntlnc) = dvdftra(i,k,8) + ten_q(i,k,ntinc) = dvdftra(i,k,9) + ten_q(i,k,ntrnc) = dvdftra(i,k,10) + ten_q(i,k,ntsnc) = dvdftra(i,k,11) + ten_q(i,k,ntgnc) = dvdftra(i,k,12) + ten_q(i,k,nthnc) = dvdftra(i,k,13) + ten_q(i,k,ntgv) = dvdftra(i,k,14) + ten_q(i,k,nthv) = dvdftra(i,k,15) + ten_q(i,k,ntoz) = dvdftra(i,k,16) n = 16 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + ten_q(i,k,ntccn) = dvdftra(i,k,n+1) n = n+1 ENDIF IF ( nssl_3moment ) THEN - dqdt(i,k,ntrz) = dvdftra(i,k,n+1) - dqdt(i,k,ntgz) = dvdftra(i,k,n+2) - dqdt(i,k,nthz) = dvdftra(i,k,n+3) + ten_q(i,k,ntrz) = dvdftra(i,k,n+1) + ten_q(i,k,ntgz) = dvdftra(i,k,n+2) + ten_q(i,k,nthz) = dvdftra(i,k,n+3) n = n+3 ENDIF enddo @@ -291,27 +295,27 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, do k=1,levs do i=1,im - dqdt(i,k,ntqv) = dvdftra(i,k,1) - dqdt(i,k,ntcw) = dvdftra(i,k,2) - dqdt(i,k,ntiw) = dvdftra(i,k,3) - dqdt(i,k,ntrw) = dvdftra(i,k,4) - dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntgl) = dvdftra(i,k,6) - dqdt(i,k,ntlnc) = dvdftra(i,k,7) - dqdt(i,k,ntinc) = dvdftra(i,k,8) - dqdt(i,k,ntrnc) = dvdftra(i,k,9) - dqdt(i,k,ntsnc) = dvdftra(i,k,10) - dqdt(i,k,ntgnc) = dvdftra(i,k,11) - dqdt(i,k,ntgv) = dvdftra(i,k,12) - dqdt(i,k,ntoz) = dvdftra(i,k,13) + ten_q(i,k,ntqv) = dvdftra(i,k,1) + ten_q(i,k,ntcw) = dvdftra(i,k,2) + ten_q(i,k,ntiw) = dvdftra(i,k,3) + ten_q(i,k,ntrw) = dvdftra(i,k,4) + ten_q(i,k,ntsw) = dvdftra(i,k,5) + ten_q(i,k,ntgl) = dvdftra(i,k,6) + ten_q(i,k,ntlnc) = dvdftra(i,k,7) + ten_q(i,k,ntinc) = dvdftra(i,k,8) + ten_q(i,k,ntrnc) = dvdftra(i,k,9) + ten_q(i,k,ntsnc) = dvdftra(i,k,10) + ten_q(i,k,ntgnc) = dvdftra(i,k,11) + ten_q(i,k,ntgv) = dvdftra(i,k,12) + ten_q(i,k,ntoz) = dvdftra(i,k,13) n = 13 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + ten_q(i,k,ntccn) = dvdftra(i,k,n+1) n = n+1 ENDIF IF ( nssl_3moment ) THEN - dqdt(i,k,ntrz) = dvdftra(i,k,n+1) - dqdt(i,k,ntgz) = dvdftra(i,k,n+2) + ten_q(i,k,ntrz) = dvdftra(i,k,n+1) + ten_q(i,k,ntgz) = dvdftra(i,k,n+2) n = n+2 ENDIF enddo @@ -322,6 +326,62 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif ! nvdiff == ntrac + + + case_PBL_ten: select case (tend_opt_pbl) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*ten_t(i,k) + gu0(i,k) = gu0(i,k) + dtp*ten_u(i,k) + gv0(i,k) = gv0(i,k) + dtp*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + dtp*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + dtp*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_PBL_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_PBL_ten + ! --- ... coupling insertion if (cplflx) then @@ -429,33 +489,33 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (lsidea) then idtend = dtidx(index_of_temperature, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + dtdt(1:im,1:levs)*dtf + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_t(1:im,1:levs)*dtf endif else idtend = dtidx(index_of_temperature, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (tgrs(1:im,1:levs) - save_t(1:im,1:levs)) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_t(1:im,1:levs)*dtp endif endif idtend = dtidx(index_of_x_wind, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (ugrs(1:im,1:levs) - save_u(1:im,1:levs)) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_u(1:im,1:levs)*dtp endif idtend = dtidx(index_of_y_wind, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (vgrs(1:im,1:levs) - save_v(1:im,1:levs)) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_v(1:im,1:levs)*dtp endif idtend = dtidx(100+ntqv, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + qgrs(1:im,1:levs,ntqv) - save_q(1:im,1:levs,ntqv) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_q(1:im,1:levs,ntqv)*dtp endif idtend = dtidx(100+ntoz, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + qgrs(1:im,1:levs,ntoz) - save_q(1:im,1:levs,ntoz) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_q(1:im,1:levs,ntoz)*dtp endif idtend = dtidx(100+ntke, index_of_process_pbl) if(idtend>=1) then - dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (qgrs(1:im,1:levs,ntke) - save_q(1:im,1:levs,ntke)) + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + ten_q(1:im,1:levs,ntke)*dtp endif endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta index 057d061a4..0b1a8351c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta @@ -155,6 +155,13 @@ dimensions = () type = integer intent = in +[tend_opt_pbl] + standard_name = control_for_application_method_of_planetary_boundary_layer_tendencies + long_name = control for application method of planetary boundary layer tendencies + units = 1 + dimensions = () + type = integer + intent = in [trans_aero] standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion long_name = flag for aerosol convective transport and PBL diffusion @@ -415,6 +422,38 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in [dusfc1] standard_name = instantaneous_surface_x_momentum_flux long_name = surface momentum flux in the x-direction valid for current call @@ -499,6 +538,14 @@ type = real kind = kind_phys intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = updated tendency of the x wind @@ -506,7 +553,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [dvdt] standard_name = process_split_cumulative_tendency_of_y_wind long_name = updated tendency of the y wind @@ -514,7 +561,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = updated tendency of the temperature @@ -522,31 +569,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep - long_name = total sky sw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in + intent = inout [dqdt] standard_name = process_split_cumulative_tendency_of_tracers long_name = updated tendency of the tracers due to model physics @@ -912,7 +935,7 @@ kind = kind_phys intent = in [ugrs1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = zonal wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -920,7 +943,7 @@ kind = kind_phys intent = in [vgrs1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = meridional wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -936,7 +959,7 @@ kind = kind_phys intent = in [ugrs] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -944,7 +967,7 @@ kind = kind_phys intent = in [vgrs] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -952,7 +975,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -960,53 +983,53 @@ kind = kind_phys intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys intent = in -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) +[huge] + standard_name = netcdf_float_fillvalue + long_name = definition of NetCDF float FillValue + units = none + dimensions = () type = real kind = kind_phys intent = in -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme + intent = inout +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in -[huge] - standard_name = netcdf_float_fillvalue - long_name = definition of NetCDF float FillValue - units = none - dimensions = () + intent = inout +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics + units = m s-1 + 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/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 index eab767147..230c5f254 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 @@ -16,8 +16,8 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, imp_physics_nssl, & ltaerosol, mraerosol, nssl_ccn_on, nssl_hail_on, nssl_3moment, & - hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & - flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, & + ugrs, vgrs, tgrs, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -30,18 +30,16 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz - logical, intent(in) :: trans_aero, ldiag3d, qdiag3d, lssav + logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: ltaerosol, hybedmf, do_shoc, satmedmf, flag_for_pbl_generic_tend, mraerosol + logical, intent(in) :: ltaerosol, hybedmf, do_shoc, satmedmf, mraerosol integer, intent(in) :: imp_physics_nssl logical, intent(in) :: nssl_hail_on, nssl_ccn_on, nssl_3moment real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs real(kind=kind_phys), dimension(:,:, :), intent(inout) :: vdftra - real(kind=kind_phys), dimension(:,:), intent(out) :: save_u, save_v, save_t - real(kind=kind_phys), dimension(:,:, :), intent(out) :: save_q ! CCPP error handling variables character(len=*), intent(out) :: errmsg @@ -301,31 +299,6 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, ! endif - if(ldiag3d .and. lssav .and. flag_for_pbl_generic_tend) then - do k=1,levs - do i=1,im - save_t(i,k) = tgrs(i,k) - save_u(i,k) = ugrs(i,k) - save_v(i,k) = vgrs(i,k) - enddo - enddo - if(qdiag3d) then - do k=1,levs - do i=1,im - save_q(i,k,ntqv) = qgrs(i,k,ntqv) - save_q(i,k,ntoz) = qgrs(i,k,ntoz) - enddo - enddo - if(ntke>0) then - do k=1,levs - do i=1,im - save_q(i,k,ntke) = qgrs(i,k,ntke) - enddo - enddo - endif - endif - endif - end subroutine GFS_PBL_generic_pre_run end module GFS_PBL_generic_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta index 7a8e72bba..c75482e28 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta @@ -366,66 +366,6 @@ type = real kind = kind_phys intent = inout -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = out -[flag_for_pbl_generic_tend] - standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer - long_name = true if GFS_PBL_generic should calculate tendencies - units = flag - dimensions = () - type = logical - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[lssav] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in [ugrs] standard_name = x_wind long_name = zonal wind diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 index 8102d70eb..6d6665028 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 @@ -8,9 +8,9 @@ module GFS_SCNV_generic_post !> \section arg_table_GFS_SCNV_generic_post_run Argument Table !! \htmlinclude GFS_SCNV_generic_post_run.html !! - subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & - frain, gu0, gv0, gt0, gq0, save_u, save_v, save_t, save_q, & - clw, shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, nsamftrac, & + subroutine GFS_SCNV_generic_post_run (im, levs, tracers_total, otsptflag, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, tend_opt_scnv, lssav, ldiag3d, qdiag3d, & + frain, gu0, gv0, gt0, gq0, dudt, dvdt, dtdt, dqdt, ten_t, ten_u, ten_v, ten_q, delt, & + clw, dclw, shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, nsamftrac, & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & index_of_process_scnv, ntqv, flag_for_scnv_generic_tend, & @@ -22,19 +22,20 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & implicit none - integer, intent(in) :: im, levs, nn, ntqv, nsamftrac + integer, intent(in) :: im, levs, ntqv, nsamftrac, tracers_total, tend_opt_scnv + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc,ntsigma,ntrac logical, intent(in) :: lssav, ldiag3d, qdiag3d, flag_for_scnv_generic_tend + logical, dimension(:), intent(in) :: otsptflag real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 - real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t - real(kind=kind_phys), dimension(:,:,:), intent(in) :: save_q, gq0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 ! dtend only allocated if ldiag3d == .true. real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_scnv - real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw, dclw ! Post code for SAS/SAMF integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d @@ -56,9 +57,92 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & integer :: i, k, n, idtend, tracers real(kind=kind_phys) :: tem + real(kind=kind_phys), dimension(:,:), intent(in) :: ten_t, ten_u, ten_v + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: ten_q + real(kind=kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt, dtdt + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dqdt + real(kind=kind_phys), intent(in) :: delt + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + !ten_q(:,:,1) already has a value from the shallow convection scheme + if (tracers_total > 0) then + tracers = 2 + do n=2,ntrac + if ( otsptflag(n) ) then + tracers = tracers + 1 + ten_q(1:im,:,n) = dclw(1:im,:,tracers) + endif + enddo + endif + if (ntcw > 0) then + if (imp_physics == imp_physics_zhao_carr .or. & + imp_physics == imp_physics_zhao_carr_pdf .or. & + imp_physics == imp_physics_gfdl) then + ten_q(1:im,:,ntcw) = dclw(1:im,:,1) + dclw(1:im,:,2) + elseif (ntiw > 0) then + ten_q(1:im,:,ntiw) = dclw(1:im,:,1) + ten_q(1:im,:,ntcw) = dclw(1:im,:,2) + else + ten_q(1:im,:,ntcw) = dclw(1:im,:,1) + dclw(1:im,:,2) + endif ! end if_ntiw + endif ! end if_ntcw + + case_SCNV_ten: select case (tend_opt_scnv) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*ten_t(i,k) + gu0(i,k) = gu0(i,k) + delt*ten_u(i,k) + gv0(i,k) = gv0(i,k) + delt*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + delt*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + delt*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_SCNV_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_SCNV_ten if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then do i=1,im @@ -85,17 +169,17 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & if (ldiag3d) then idtend = dtidx(index_of_temperature, index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0 - save_t) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_t * delt) * frain endif idtend = dtidx(index_of_x_wind, index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0 - save_u) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_u * delt) * frain endif idtend = dtidx(index_of_y_wind, index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_v * delt) * frain endif if (cscnv .or. satmedmf .or. trans_trac .or. ras) then @@ -107,7 +191,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & tracers = tracers + 1 idtend = dtidx(100+n,index_of_process_scnv) if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-save_q(:,:,n) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,n)*delt) * frain endif endif enddo @@ -115,13 +199,13 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & do n=2,ntrac idtend = dtidx(100+n,index_of_process_scnv) if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,n)*delt)*frain endif enddo endif idtend = dtidx(100+ntqv, index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (ten_q(:,:,ntqv)*delt) * frain endif endif endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta index f90fccf01..66c34b8f3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta @@ -22,13 +22,55 @@ dimensions = () type = integer intent = in -[nn] - standard_name = number_of_tracers_for_convective_transport - long_name = number of tracers for convective transport +[tracers_total] + standard_name = number_of_total_tracers + long_name = total number of tracers units = count dimensions = () type = integer intent = in +[otsptflag] + standard_name = flag_convective_tracer_transport_interstitial + long_name = flag for interstitial tracer transport + units = flag + dimensions = (number_of_tracers) + type = logical + intent = in +[imp_physics] + standard_name = control_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_gfdl] + standard_name = identifier_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_zhao_carr] + standard_name = identifier_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_zhao_carr_pdf] + standard_name = identifier_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in +[tend_opt_scnv] + standard_name = control_for_application_method_of_shallow_convection_tendencies + long_name = control for application method of shallow convection tendencies + units = 1 + dimensions = () + type = integer + intent = in [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics @@ -58,70 +100,110 @@ type = real kind = kind_phys intent = in +[delt] + standard_name = timestep_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in + intent = inout [dtend] standard_name = cumulative_change_of_state_variables long_name = diagnostic tendencies for state variables @@ -181,6 +263,14 @@ type = real kind = kind_phys intent = in +[dclw] + standard_name = tendency_of_convective_transportable_tracers + long_name = array to contain tendencies of cloud water and other convective trans. tracers + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = in [shcnvcw] standard_name = flag_for_saving_shallow_convective_cloud_area_fraction long_name = flag for shallow convective cloud diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 deleted file mode 100644 index d89a33302..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 +++ /dev/null @@ -1,73 +0,0 @@ -!> \file GFS_SCNV_generic_pre.F90 -!! Contains code related to shallow convective schemes to be run prior to shallow convection for GFS-based physics suites. - - module GFS_SCNV_generic_pre - - contains - -!> \section arg_table_GFS_SCNV_generic_pre_run Argument Table -!! \htmlinclude GFS_SCNV_generic_pre_run.html -!! - subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, gq0, & - save_u, save_v, save_t, save_q, ntqv, nsamftrac, flag_for_scnv_generic_tend, & - dtidx, index_of_process_scnv, ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, & - ntsigma, cscnv, satmedmf, trans_trac, ras, ntrac, clw, errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: im, levs, ntqv, nsamftrac, index_of_process_scnv, dtidx(:,:) - integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, ntsigma,ntrac - logical, intent(in) :: ldiag3d, qdiag3d, flag_for_scnv_generic_tend - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 - real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0 - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u, save_v, save_t - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - logical, intent(in) :: cscnv, satmedmf, trans_trac, ras - real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw - - integer :: i, k, n, tracers - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (ldiag3d .and. flag_for_scnv_generic_tend) then - do k=1,levs - do i=1,im - save_u(i,k) = gu0(i,k) - save_v(i,k) = gv0(i,k) - save_t(i,k) = gt0(i,k) - enddo - enddo - if (qdiag3d) then - if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - tracers = 2 - do n=2,ntrac - if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & - n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & - n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. n /= ntsigma) then - tracers = tracers + 1 - if(dtidx(100+n,index_of_process_scnv)>0) then - save_q(:,:,n) = clw(:,:,tracers) - endif - endif - enddo - else - do n=2,ntrac - if(dtidx(100+n,index_of_process_scnv)>0) then - save_q(:,:,n) = gq0(:,:,n) - endif - enddo - endif ! end if_ras or cfscnv or samf - save_q(:,:,ntqv) = gq0(:,:,ntqv) - endif - endif - - end subroutine GFS_SCNV_generic_pre_run - - - end module GFS_SCNV_generic_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta deleted file mode 100644 index fbd9e47d8..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta +++ /dev/null @@ -1,264 +0,0 @@ -[ccpp-table-properties] - name = GFS_SCNV_generic_pre - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = GFS_SCNV_generic_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_layer_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[gu0] - standard_name = x_wind_of_new_state - long_name = updated x-direction wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gv0] - standard_name = y_wind_of_new_state - long_name = updated y-direction wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0] - standard_name = tracer_concentration_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[nsamftrac] - standard_name = number_of_tracers_for_samf - long_name = number of tracers for scale-aware mass flux schemes - units = count - dimensions = () - type = integer - intent = in -[flag_for_scnv_generic_tend] - standard_name = flag_for_generic_tendency_due_to_shallow_convection - long_name = true if GFS_SCNV_generic should calculate tendencies - units = flag - dimensions = () - type = logical - intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[cscnv] - standard_name = flag_for_Chikira_Sugiyama_deep_convection - long_name = flag for Chikira-Sugiyama convection - units = flag - dimensions = () - type = logical - intent = in -[satmedmf] - standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL - long_name = flag for scale-aware TKE moist EDMF PBL scheme - units = flag - dimensions = () - type = logical - intent = in -[trans_trac] - standard_name = flag_for_convective_transport_of_tracers - long_name = flag for convective transport of tracers - units = flag - dimensions = () - type = logical - intent = in -[ras] - standard_name = flag_for_relaxed_arakawa_schubert_deep_convection - long_name = flag for ras convection scheme - units = flag - dimensions = () - type = logical - intent = in -[ntsigma] - standard_name = index_of_updraft_area_fraction_in_tracer_concentration_array - long_name = tracer index of updraft_area_fraction - units = index - dimensions = () - type = integer - intent = in -[ntcw] - standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in -[ntiw] - standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in -[ntclamt] - standard_name = index_of_cloud_area_fraction_in_atmosphere_layer_in_tracer_concentration_array - long_name = tracer index for cloud amount integer - units = index - dimensions = () - type = integer - intent = in -[ntrw] - standard_name = index_of_rain_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for rain water - units = index - dimensions = () - type = integer - intent = in -[ntsw] - standard_name = index_of_snow_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for snow water - units = index - dimensions = () - type = integer - intent = in -[ntrnc] - standard_name = index_of_mass_number_concentration_of_rain_in_tracer_concentration_array - long_name = tracer index for rain number concentration - units = index - dimensions = () - type = integer - intent = in -[ntsnc] - standard_name = index_of_mass_number_concentration_of_snow_in_tracer_concentration_array - long_name = tracer index for snow number concentration - units = index - dimensions = () - type = integer - intent = in -[ntgl] - standard_name = index_of_graupel_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for graupel - units = index - dimensions = () - type = integer - intent = in -[ntgnc] - standard_name = index_of_mass_number_concentration_of_graupel_in_tracer_concentration_array - long_name = tracer index for graupel number concentration - units = index - dimensions = () - type = integer - intent = in -[clw] - standard_name = convective_transportable_tracers - long_name = array to contain cloud water and other convective trans. tracers - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) - type = real - kind = kind_phys - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index 3fb25af27..112d4c588 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -777,7 +777,7 @@ type = integer intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) @@ -785,7 +785,7 @@ kind = kind_phys intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) @@ -855,7 +855,7 @@ type = integer intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) @@ -863,7 +863,7 @@ kind = kind_phys intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) @@ -940,7 +940,7 @@ type = integer intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -948,7 +948,7 @@ kind = kind_phys intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 index 632a86597..410c1f345 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -44,18 +44,26 @@ end subroutine GFS_photochemistry_init !> \section arg_table_GFS_photochemistry_run Argument Table !! \htmlinclude GFS_photochemistry_run.html !! - subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, & - prsl, dp, ozpl, h2o_phys, h2ophys, h2opl, h2o0, oz0, gt0, do3_dt_prd, do3_dt_ozmx, & +! ######################################################################################### + subroutine GFS_photochemistry_run (dtp, ntqv, ntoz, im, levs, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, & + prsl, dp, ozpl, h2o_phys, h2ophys, h2opl, gq0, gt0, ten_q, ten_u, ten_v, ten_t, do3_dt_prd, do3_dt_ozmx, & do3_dt_temp, do3_dt_ohoz, dqv_dt_prd, dqv_dt_qvmx, errmsg, errflg) ! Inputs real(kind=kind_phys), intent(in) :: & dtp, & ! Model timestep con_1ovg ! Physical constant (1./gravity) + integer, intent(in) :: & + ntqv, &! index for specific humidity in the tracer array + ntoz, &! index for ozone in the the tracer array + im, &! horizontal loop extent + levs ! vertical dimension real(kind=kind_phys), intent(in), dimension(:,:) :: & prsl, & ! Air pressure (Pa) dp, & ! Pressure thickness (Pa) gt0 ! Air temperature (K) + real(kind=kind_phys), intent(in), dimension(:,:,:) :: & + gq0 ! tracer concentration real(kind=kind_phys), intent(in), dimension(:,:,:) :: & ozpl, & ! Ozone data for current model timestep. h2opl ! h2o data for curent model timestep. @@ -78,28 +86,60 @@ subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_ dqv_dt_qvmx ! Physics tendency: specific humidity effect ! Outputs - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - oz0, & ! Update ozone concentration. - h2o0 ! Updated h2o concentration. + real(kind=kind_phys), intent(out), dimension(:,:) :: & + ten_u, ten_v, ten_t + real(kind=kind_phys), intent(out), dimension(:,:,:) :: & + ten_q ! tendency of tracer concentration character(len=*), intent(out) :: & errmsg ! CCPP Error message. integer, intent(out) :: & errflg ! CCPP Error flag. - + + ! Locals + integer :: i,k + real(kind=kind_phys), dimension(im,levs) :: & + init_oz0, oz0, & ! initial and updated local ozone concentration + init_h2o0, h2o0 ! initial and updated local h2o concentration + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + ten_u(:,:) = 0.0_kind_phys + ten_v(:,:) = 0.0_kind_phys + ten_t(:,:) = 0.0_kind_phys + ten_q(:,:,:) = 0.0_kind_phys if (oz_phys_2015) then + init_oz0 = gq0(:,:,ntoz) + oz0 = init_oz0 call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + do i=1, im + do k=1, levs + ten_q(i,k,ntoz) = (oz0(i,k) - init_oz0(i,k))/dtp + end do + end do endif if (oz_phys_2006) then + init_oz0 = gq0(:,:,ntoz) + oz0 = init_oz0 call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + do i=1, im + do k=1, levs + ten_q(i,k,ntoz) = (oz0(i,k) - init_oz0(i,k))/dtp + end do + end do endif if (h2o_phys) then + init_h2o0 = gq0(:,:,ntqv) + h2o0 = init_h2o0 call h2ophys%run(dtp, prsl, h2opl, h2o0, dqv_dt_prd, dqv_dt_qvmx) + do i=1, im + do k=1, levs + ten_q(i,k,ntqv) = (h2o0(i,k) - init_h2o0(i,k))/dtp + end do + end do endif end subroutine GFS_photochemistry_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta index a89773b12..1e460cdd5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -58,6 +58,34 @@ type = real kind = kind_phys intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in [ozphys] standard_name = dataset_for_ozone_physics long_name = dataset for NRL ozone physics @@ -133,30 +161,54 @@ type = real kind = kind_phys intent = in -[h2o0] - standard_name = specific_humidity_of_new_state - long_name = water vapor specific humidity updated by physics +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[oz0] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [do3_dt_prd] standard_name = ozone_tendency_due_to_production_and_loss_rate long_name = ozone tendency due to production and loss rate diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.F90 new file mode 100644 index 000000000..c1e2a40dc --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.F90 @@ -0,0 +1,98 @@ +! ######################################################################################### +!> \file GFS_photochemistry_post.f90 +!! +! ######################################################################################### +module GFS_photochemistry_post + use machine, only: kind_phys + implicit none +contains + +! ######################################################################################### +!> \section arg_table_GFS_photochemistry_post_run Argument Table +!! \htmlinclude GFS_photochemistry_post_run.html +!! +! ######################################################################################### + subroutine GFS_photochemistry_post_run (tend_opt_photochem, im, levs, ntrac, & + dtp, ten_t, ten_u, ten_v, ten_q, gt0, gu0, gv0, gq0, dtdt, dudt, dvdt, dqdt, & + errmsg, errflg) + + ! Inputs + integer, intent(in) :: tend_opt_photochem, im, levs, ntrac + real(kind=kind_phys), intent(in) :: dtp + real(kind=kind_phys), intent(in), dimension(:,:) :: ten_u, ten_v, ten_t + real(kind=kind_phys), intent(in), dimension(:,:,:) :: ten_q + real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dqdt + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP Error message. + integer, intent(out) :: & + errflg ! CCPP Error flag. + + ! Locals + integer :: i,k,n + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + case_photochemistry_ten: select case (tend_opt_photochem) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*ten_t(i,k) + gu0(i,k) = gu0(i,k) + dtp*ten_u(i,k) + gv0(i,k) = gv0(i,k) + dtp*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + dtp*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + dtp*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_photochemistry_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_photochemistry_ten + + end subroutine GFS_photochemistry_post_run + +end module GFS_photochemistry_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.meta similarity index 67% rename from physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.meta index 8a0d784f2..dfc2be051 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry_post.meta @@ -1,13 +1,20 @@ ######################################################################## [ccpp-table-properties] - name = GFS_suite_stateout_update + name = GFS_photochemistry_post type = scheme - dependencies = ../../hooks/machine.F - + dependencies = ../../hooks/machine.F, + ######################################################################## [ccpp-arg-table] - name = GFS_suite_stateout_update_run + name = GFS_photochemistry_post_run type = scheme +[tend_opt_photochem] + standard_name = control_for_application_method_of_photochemistry_tendencies + long_name = control for application method of photochemistry tendencies + units = 1 + dimensions = () + type = integer + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -37,138 +44,102 @@ type = real kind = kind_phys intent = in -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[dqdt] - standard_name = process_split_cumulative_tendency_of_tracers - long_name = updated tendency of the tracers +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = out -[ntiw] - standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in -[nqrimef] - standard_name = index_of_mass_weighted_rime_factor_in_tracer_concentration_array - long_name = tracer index for mass weighted rime factor - units = index - dimensions = () - type = integer - intent = in -[imp_physics] - standard_name = control_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_fer_hires] - standard_name = identifier_for_fer_hires_microphysics_scheme - long_name = choice of Ferrier-Aligo microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -183,4 +154,5 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out + \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta index a7ac1381c..bce6b974d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta @@ -207,7 +207,7 @@ intent = inout optional = True [t] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -215,7 +215,7 @@ kind = kind_phys intent = in [qv] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta index a7ac1381c..bce6b974d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta @@ -207,7 +207,7 @@ intent = inout optional = True [t] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -215,7 +215,7 @@ kind = kind_phys intent = in [qv] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 index ddc3f7b54..c73825cbd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 @@ -57,20 +57,21 @@ module GFS_radiation_post ! ########################################################################################### ! GFS_radiation_post_run ! ########################################################################################### - subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, fhlwr, fhswr,& - coszen, coszdg, raddt, aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, tgrs, kb, & - kd, kt, sfcflw, sfcfsw, topflw, scmpsw, nCol, nLev, lmk, nDay, nfxr, nspc1, fluxr, & + subroutine GFS_radiation_post_run(doLWrad, doSWrad, tend_opt_lwrad, tend_opt_swrad, lssav, total_albedo, topfsw, fhlwr, fhswr, delt, & + coszen, coszdg, raddt, aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, kb, & + kd, kt, sfcflw, sfcfsw, topflw, scmpsw, nCol, nLev, ntrac, lmk, nDay, nfxr, nspc1, fluxr, & do_RRTMGP, do_lw_clrsky_hr, fluxlwUP_clrsky, fluxlwDOWN_clrsky, htrlwc, fluxlwUP_allsky, & fluxlwDOWN_allsky, htrlw, do_sw_clrsky_hr, htrswc, fluxswUP_clrsky, idxday, & fluxswDOWN_clrsky, htrsw, fluxswUP_allsky, fluxswDOWN_allsky, iSFC, iTOA, tsflw, tsfa, & sfcdlw, sfculw, htrlwu, nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, & visdfui, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfcnsw, & - sfcdsw, errmsg, errflg) + sfcdsw, gu0, gv0, gt0, gq0, dudt, dvdt, dtdt, dqdt, ten_t, ten_u, ten_v, ten_q, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & !< Horizontal loop extent nLev, & !< Number of vertical layers + ntrac, & !< number of tracers lmk, & !< Number of vertical layers for radiation (adjusted) nDay, & !< Number of daylit columns nfxr, & !< Number of variables stored in the fluxr array @@ -79,7 +80,9 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, kd, & !< Vertical index difference between in/out and local (H/M/L diag) kt, & !< Vertical index difference between layer and upper bound (H/M/L diag) iSFC, & !< Vertical index for surface level - iTOA !< Vertical index for TOA level + iTOA, & !< Vertical index for TOA level + tend_opt_swrad, & + tend_opt_lwrad integer, intent(in), dimension(:) :: & idxday !< Index array for daytime points logical, intent(in) :: & @@ -88,11 +91,12 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, lssav, & !< Flag for radiation diagnostics do_RRTMGP, & !< Flag for using RRTMGP scheme do_lw_clrsky_hr, & !< Output clear-sky LW heating-rate? - do_sw_clrsky_hr !< Output clear-sky SW heating-rate? + do_sw_clrsky_hr !< Output clear-sky SW heating-rate? real(kind_phys), intent(in) :: & fhlwr, & !< Frequency for longwave radiation (sec) fhswr, & !< Frequency for shortwave radiation (sec) - raddt !< Radiation time step (sec) + raddt, & !< Radiation time step (sec) + delt !< physics timestep real(kind_phys), dimension(:), intent(in) :: & coszen, & !< Mean cos of zenith angle over rad call period coszdg !< Daytime mean cosz over rad call period @@ -104,8 +108,6 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, sfc_alb_uvvis_dif !< Surface albedo (diffuse) real(kind_phys), dimension(:,:), intent(in) :: & p_lev !< Pressure @ model layer-interfaces (Pa) - real(kind_phys), dimension(:,:), intent(in) :: & - tgrs !< Temperature @ model layer-centers (K) real(kind_phys), dimension(:,:), intent(in), optional :: & fluxlwUP_clrsky, & !< RRTMGP longwave clear-sky flux (W/m2) fluxlwDOWN_clrsky, & !< RRTMGP longwave clear-sky flux (W/m2) @@ -166,6 +168,12 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, topflw !< LW fluxes at top atmosphere real(kind_phys), dimension(:,:), intent(inout) :: & fluxr !< LW/SW diagnostics + real(kind_phys), dimension(:,:), intent(inout) :: gu0, gv0, gt0 + real(kind_phys), dimension(:,:,:), intent(inout) :: gq0 + real(kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt, dtdt + real(kind_phys), dimension(:,:,:), intent(inout) :: dqdt + real(kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u, ten_v + real(kind_phys), dimension(:,:,:), intent(out) :: ten_q character(len=*), intent(out) :: & errmsg !< CCPP error message integer, intent(out) :: & @@ -176,7 +184,7 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, htrswc !< SW clear-sky heating rate (K/s) ! Local variables - integer :: i + integer :: i, k, n real(rte_wp), dimension(nDay, nLev) :: thetaTendClrSkySW, thetaTendAllSkySW real(rte_wp), dimension(nCol, nLev) :: thetaTendClrSkyLW, thetaTendAllSkyLW @@ -184,8 +192,10 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, errmsg = '' errflg = 0 - ! Only proceed if radiation is being called. - if (.not. (doLWrad .or. doSWrad)) return + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 ! ####################################################################################### ! Longwave Radiation @@ -232,7 +242,67 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, htrlwu = htrlw endif ! RRTMGP Longwave Radiaiton endif ! ALL Longwave Radiation - + + !htrlw is calculated in rrtmg_lw_post if using RRTMG and above if using RRTMGP + ten_t = htrlw + + !remove tendency code from rrtmg_sw_post and rrtmg_lw_post + + !This may belong in a separate GFS_radsw_post routine rather than here, although it would need to be created + case_LWRAD_ten: select case (tend_opt_lwrad) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,nlev + do i=1,ncol + gt0(i,k) = gt0(i,k) + delt*ten_t(i,k) + gu0(i,k) = gu0(i,k) + delt*ten_u(i,k) + gv0(i,k) = gv0(i,k) + delt*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,nlev + do i=1,ncol + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,nlev + do i=1,ncol + gt0(i,k) = gt0(i,k) + delt*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + delt*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + delt*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_LWRAD_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_LWRAD_ten + ! ####################################################################################### ! Shortwave Radiation ! ####################################################################################### @@ -314,7 +384,7 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, enddo endif ! RRTMGP Shortwave Radiaiton endif ! ALL Shortwave Radiation - + ! The total sky (with clouds) shortwave albedo total_albedo = 0.0 where(topfsw(:)%dnfxc>0) total_albedo(:) = topfsw(:)%upfxc/topfsw(:)%dnfxc @@ -324,9 +394,66 @@ subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, ! ######################################################################################### if (lssav) then call GFS_radiation_diagnostics(doLWrad, doSWrad, fhlwr, fhswr, coszen, coszdg, raddt, & - aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, tgrs, kb, kd, kt, sfcflw, & + aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, gt0, kb, kd, kt, sfcflw, & sfcfsw, topfsw, topflw, scmpsw, nCol, nDay, nLev, lmk, nfxr, nspc1, fluxr) endif + + !htrsw is calculated in rrtmg_sw_post if using RRTMG and above if using RRTMGP + ten_t = htrsw + + case_SWRAD_ten: select case (tend_opt_swrad) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,nlev + do i=1,ncol + gt0(i,k) = gt0(i,k) + delt*ten_t(i,k) + gu0(i,k) = gu0(i,k) + delt*ten_u(i,k) + gv0(i,k) = gv0(i,k) + delt*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,nlev + do i=1,ncol + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,nlev + do i=1,ncol + gt0(i,k) = gt0(i,k) + delt*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + delt*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + delt*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_SWRAD_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_SWRAD_ten end subroutine GFS_radiation_post_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta index b8a05e258..8c373b308 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta @@ -12,7 +12,7 @@ type = scheme [doLWrad] standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls + long_name = logical flags for lw radiation calls units = flag dimensions = () type = logical @@ -24,6 +24,20 @@ dimensions = () type = logical intent = in +[tend_opt_lwrad] + standard_name = control_for_application_method_of_longwave_radiation_tendencies + long_name = control for application method of longwave radiation tendencies + units = 1 + dimensions = () + type = integer + intent = in +[tend_opt_swrad] + standard_name = control_for_application_method_of_shortwave_radiation_tendencies + long_name = control for application method of shortwave radiation tendencies + units = 1 + dimensions = () + type = integer + intent = in [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics @@ -62,6 +76,14 @@ type = real kind = kind_phys intent = in +[delt] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [coszen] standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep long_name = mean cos of zenith angle over rad call period @@ -140,14 +162,6 @@ type = real kind = kind_phys intent = in -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [kb] standard_name = vertical_index_difference_between_layer_and_lower_bound long_name = vertical index difference between layer and lower bound @@ -211,6 +225,13 @@ dimensions = () type = integer intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in [lmk] standard_name = adjusted_vertical_layer_dimension_for_radiation long_name = adjusted number of vertical layers for radiation @@ -548,6 +569,102 @@ type = real kind = kind_phys intent = inout +[gu0] + standard_name = x_wind + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta index 904030522..b9b54de44 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta @@ -210,7 +210,7 @@ kind = kind_phys intent = in [ugrs] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -218,7 +218,7 @@ kind = kind_phys intent = in [vgrs] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -226,7 +226,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -234,7 +234,7 @@ kind = kind_phys intent = in [qgrs_wv] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -242,7 +242,7 @@ kind = kind_phys intent = in [qgrs_cw] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -250,7 +250,7 @@ kind = kind_phys intent = in [qgrs_rw] - standard_name = rain_mixing_ratio + standard_name = physics_timestep_initial_rain_mixing_ratio long_name = moist mixing ratio of rain units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -258,7 +258,7 @@ kind = kind_phys intent = in [qgrs_sw] - standard_name = snow_mixing_ratio + standard_name = physics_timestep_initial_snow_mixing_ratio long_name = moist mixing ratio of snow units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -266,7 +266,7 @@ kind = kind_phys intent = in [qgrs_iw] - standard_name = cloud_ice_mixing_ratio + standard_name = physics_timestep_initial_cloud_ice_mixing_ratio long_name = moist mixing ratio of cloud ice units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -274,7 +274,7 @@ kind = kind_phys intent = in [qgrs_gl] - standard_name = graupel_mixing_ratio + standard_name = physics_timestep_initial_graupel_mixing_ratio long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -282,7 +282,7 @@ kind = kind_phys intent = in [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -290,7 +290,7 @@ kind = kind_phys intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -298,7 +298,7 @@ kind = kind_phys intent = inout [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -306,7 +306,7 @@ kind = kind_phys intent = inout [gq0_wv] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -323,7 +323,7 @@ intent = inout optional = True [gq0_cw] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = cloud condensed water mixing ratio updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -331,7 +331,7 @@ kind = kind_phys intent = inout [gq0_rw] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = moist mixing ratio of rain updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -339,7 +339,7 @@ kind = kind_phys intent = inout [gq0_sw] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = moist mixing ratio of snow updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -347,7 +347,7 @@ kind = kind_phys intent = inout [gq0_iw] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = moist mixing ratio of cloud ice updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -355,7 +355,7 @@ kind = kind_phys intent = inout [gq0_gl] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 index 923cee897..f9e02f6eb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 @@ -131,55 +131,35 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure enddo - if (ldiag3d) then - if (lsidea) then - idtend = dtidx(index_of_temperature,index_of_process_longwave) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf - endif - - idtend = dtidx(index_of_temperature,index_of_process_shortwave) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf - endif + if (ldiag3d .and. lsidea) then + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf + endif - idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,3)*dtf - endif + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf + endif - idtend = dtidx(index_of_temperature,index_of_process_dcnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,4)*dtf - endif + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,3)*dtf + endif - idtend = dtidx(index_of_temperature,index_of_process_scnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,5)*dtf - endif + idtend = dtidx(index_of_temperature,index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,4)*dtf + endif - idtend = dtidx(index_of_temperature,index_of_process_mp) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf - endif - else - idtend = dtidx(index_of_temperature,index_of_process_longwave) - if(idtend>=1) then - if (use_LW_jacobian) then - dtend(:,:,idtend) = dtend(:,:,idtend) + htrlwu(:,:)*dtf - else - dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf - endif - endif + idtend = dtidx(index_of_temperature,index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,5)*dtf + endif - idtend = dtidx(index_of_temperature,index_of_process_shortwave) - if(idtend>=1) then - do k=1,levs - do i=1,im - dtend(i,k,idtend) = dtend(i,k,idtend) + htrsw(i,k)*dtf*xmu(i) - enddo - enddo - endif + idtend = dtidx(index_of_temperature,index_of_process_mp) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf endif endif endif ! end if_lssav_block diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta index a1f1660ad..9eb1147ef 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta @@ -214,7 +214,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -230,7 +230,7 @@ kind = kind_phys intent = in [qgrs_water_vapor] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -238,7 +238,7 @@ kind = kind_phys intent = in [qgrs_cloud_water] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 index b3d59c095..dba1141d9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 @@ -18,12 +18,11 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & xlon, xlat, gt0, gq0, sigmain,sigmaout,qmicro, & omegain,omegaout,imp_physics, imp_physics_mg, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, dtidx, ntlnc, & - imp_physics_wsm6, imp_physics_fer_hires, prsi, ntinc, & + imp_physics_gfdl, imp_physics_thompson, & + imp_physics_wsm6, imp_physics_fer_hires, prsi, & imp_physics_nssl, imp_physics_tempo, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver, ras, me, save_lnc, save_inc, & - ldiag3d, qdiag3d, index_of_process_conv_trans, & + work1, work2, kpbl, kinver, ras, me, & clw, rhc, save_qc, save_qi, save_tcp, errmsg, errflg) use machine, only: kind_phys @@ -35,16 +34,12 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & integer, intent(in ) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, ntsw,& ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, & - imp_physics_nssl, imp_physics_tempo, me, index_of_process_conv_trans + imp_physics_nssl, imp_physics_tempo, me integer, intent(in ), dimension(:) :: islmsk, kpbl, kinver logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras, progsigma logical, intent(in ) :: first_time_step, restart, progomega integer, intent(in ) :: imfshalcnv, imfdeepcnv, imfshalcnv_samf,imfdeepcnv_samf integer, intent(in ) :: imfshalcnv_c3,imfdeepcnv_c3 - integer, intent(in) :: ntinc, ntlnc - logical, intent(in) :: ldiag3d, qdiag3d - integer, dimension(:,:), intent(in) :: dtidx - real, dimension(:,:), intent(out) :: save_lnc, save_inc real(kind=kind_phys), intent(in ) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), intent(in ), dimension(:) :: work1, work2 @@ -239,16 +234,6 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & enddo endif - if((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) & - .and. ldiag3d .and. qdiag3d) then - if(dtidx(100+ntlnc,index_of_process_conv_trans)>0) then - save_lnc = gq0(:,:,ntlnc) - endif - if(dtidx(100+ntinc,index_of_process_conv_trans)>0) then - save_inc = gq0(:,:,ntinc) - endif - endif - end subroutine GFS_suite_interstitial_3_run end module GFS_suite_interstitial_3 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta index 4cf339e4d..6f1fe5850 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta @@ -228,7 +228,7 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -236,7 +236,7 @@ kind = kind_phys intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -244,7 +244,7 @@ kind = kind_phys intent = in [sigmain] - standard_name = prognostic_updraft_area_fraction_in_convection + standard_name = physics_timestep_initial_prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -253,7 +253,7 @@ intent = inout optional = True [sigmaout] - standard_name = updraft_area_fraction_updated_by_physics + standard_name = updraft_area_fraction long_name = convective updraft area fraction updated by physics units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -505,64 +505,6 @@ type = real kind = kind_phys intent = inout -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[index_of_process_conv_trans] - standard_name = index_of_convective_transport_process_in_cumulative_change_index - long_name = index of convective transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[save_lnc] - standard_name = liquid_cloud_number_concentration_save - long_name = liquid cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[save_inc] - standard_name = ice_cloud_number_concentration_save - long_name = ice cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ntlnc] - standard_name = index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array - long_name = tracer index for liquid number concentration - units = index - dimensions = () - type = integer - intent = in -[ntinc] - standard_name = index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array - long_name = tracer index for ice number concentration - units = index - dimensions = () - type = integer - intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 index f9a2b76ea..85d647442 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 @@ -12,8 +12,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, ntccn, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_nssl, imp_physics_tempo, nssl_invertccn, nssl_ccn_on, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, dtidx, dtend,& - index_of_process_conv_trans, gq0, clw, prsl, save_tcp, con_rd, con_eps, nssl_cccn, nwfa, spechum, ldiag3d, & - qdiag3d, save_lnc, save_inc, ntk, ntke, otsptflag, errmsg, errflg) + index_of_process_conv_trans, index_of_process_dcnv, index_of_process_scnv, gq0, clw, prsl, save_tcp, con_rd, con_eps, nssl_cccn, nwfa, spechum, ldiag3d,& + qdiag3d, ntk, ntke, otsptflag, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: & @@ -39,16 +39,17 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr real(kind=kind_phys), intent(in ) :: con_pi, dtf real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qc ! save_qi is not allocated for Zhao-Carr MP - real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qi, save_lnc, save_inc + real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qi ! dtend and dtidx are only allocated if ldiag3d logical, intent(in) :: ldiag3d, qdiag3d real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, dimension(:,:), intent(in) :: dtidx - integer, intent(in) :: index_of_process_conv_trans,ntk,ntke + integer, intent(in) :: index_of_process_conv_trans,& + index_of_process_dcnv,index_of_process_scnv,ntk,ntke real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw real(kind=kind_phys), dimension(:,:), intent(in) :: prsl real(kind=kind_phys), intent(in) :: con_rd, con_eps, nssl_cccn real(kind=kind_phys), dimension(:,:), intent(in), optional :: nwfa @@ -60,7 +61,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr ! local variables real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys - integer :: i,k,n,tracers,idtend + integer :: i,k,n,tracers,idtend,idtend_deep,idtend_shal real(kind=kind_phys) :: liqm, icem, xccn, xcwmas, xccw, xcimas, qccn real(kind=kind_phys) :: rho, orho @@ -69,30 +70,29 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr real(kind=kind_phys), dimension(im,levs) :: qi_mp !< kg kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: nc_mp !< kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: ni_mp !< kg-1 (dry mixing ratio) + + real(kind=kind_phys), dimension(im,levs) :: new_lnc, new_inc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - ! This code was previously in GFS_SCNV_generic_post, but it really belongs - ! here, because it fixes the convective transportable_tracers mess for Zhao-Carr - ! and GFDL MP from GFS_suite_interstitial_3. This whole code around clw(:,:,2) - ! being set to -999 for Zhao-Carr MP (which doesn't have cloud ice) and GFDL-MP - ! (which does have cloud ice, but for some reason it was decided to code it up - ! in the same way as for Zhao-Carr, nowadays unnecessary and confusing) needs - ! to be cleaned up. The convection schemes doing something different internally - ! based on clw(i,k,2) being -999.0 or not is not a good idea. - do k=1,levs - do i=1,im - if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0 - enddo - enddo - + + if (ntlnc > 0) new_lnc = gq0(:,:,ntlnc) + if (ntinc > 0) new_inc = gq0(:,:,ntinc) + !clw is not updated after SCNV, only the whole tracer array; + if(ldiag3d) then if(ntk>0 .and. ntk<=size(clw,3)) then idtend=dtidx(100+ntke,index_of_process_conv_trans) + idtend_deep=dtidx(100+ntke,index_of_process_dcnv) + idtend_shal=dtidx(100+ntke,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk)-gq0(:,:,ntk) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif endif if(ntcw>0) then @@ -100,22 +100,50 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr imp_physics == imp_physics_zhao_carr_pdf .or. & imp_physics == imp_physics_gfdl) then idtend=dtidx(100+ntcw,index_of_process_conv_trans) + idtend_deep=dtidx(100+ntcw,index_of_process_dcnv) + idtend_shal=dtidx(100+ntcw,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif else if(ntiw>0) then idtend=dtidx(100+ntiw,index_of_process_conv_trans) + idtend_deep=dtidx(100+ntiw,index_of_process_dcnv) + idtend_shal=dtidx(100+ntiw,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)-gq0(:,:,ntiw) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif idtend=dtidx(100+ntcw,index_of_process_conv_trans) + idtend_deep=dtidx(100+ntcw,index_of_process_dcnv) + idtend_shal=dtidx(100+ntcw,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,2)-gq0(:,:,ntcw) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif else idtend=dtidx(100+ntcw,index_of_process_conv_trans) + idtend_deep=dtidx(100+ntcw,index_of_process_dcnv) + idtend_shal=dtidx(100+ntcw,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif endif endif @@ -139,178 +167,158 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr tracers = tracers + 1 if(n/=ntk .and. n/=ntlnc .and. n/=ntinc .and. n /= ntcw .and. n /= ntiw) then idtend=dtidx(100+n,index_of_process_conv_trans) + idtend_deep=dtidx(100+n,index_of_process_dcnv) + idtend_shal=dtidx(100+n,index_of_process_scnv) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-gq0(:,:,n) + if(idtend_deep>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_deep) + endif + if(idtend_shal>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtend(:,:,idtend_shal) + endif endif endif - do k=1,levs - do i=1,im - gq0(i,k,n) = clw(i,k,tracers) - enddo - enddo endif enddo endif - if (ntcw > 0) then - -! for microphysics - if (imp_physics == imp_physics_zhao_carr .or. & - imp_physics == imp_physics_zhao_carr_pdf .or. & - imp_physics == imp_physics_gfdl) then - gq0(1:im,:,ntcw) = clw(1:im,:,1) + clw(1:im,:,2) - - elseif (ntiw > 0) then - do k=1,levs - do i=1,im - gq0(i,k,ntiw) = clw(i,k,1) ! ice - gq0(i,k,ntcw) = clw(i,k,2) ! water - enddo - enddo - - if ( imp_physics == imp_physics_nssl ) then - liqm = con_pi/6.*1.e3*(18.e-6)**3 ! 4./3.*con_pi*1.e-12 - icem = con_pi/6.*1.e3*(120.e-6)**3 ! 4./3.*con_pi*3.2768*1.e-14*890. - qccn = nssl_cccn/1.225 !1.225 is a reference air density and should match what is used in module_mp_nssl_2mom.F90 (rho00) - do k=1,levs - do i=1,im - ! check number of available ccn - IF ( nssl_ccn_on ) THEN - IF ( nssl_invertccn ) THEN - xccn = qccn - gq0(i,k,ntccn) - ELSE - xccn = gq0(i,k,ntccn) - ENDIF - ELSE - xccn = Max(0.0, qccn - gq0(i,k,ntlnc)) - ENDIF - - IF ( gq0(i,k,ntlnc) > 0.0 .and. save_qc(i,k) > 0.0 ) THEN - xcwmas = Max( liqm, clw(i,k,2)/gq0(i,k,ntlnc) ) + if (ntcw > 0 .and. ntiw > 0) then + if ( imp_physics == imp_physics_nssl ) then + liqm = con_pi/6.*1.e3*(18.e-6)**3 ! 4./3.*con_pi*1.e-12 + icem = con_pi/6.*1.e3*(120.e-6)**3 ! 4./3.*con_pi*3.2768*1.e-14*890. + qccn = nssl_cccn/1.225 !1.225 is a reference air density and should match what is used in module_mp_nssl_2mom.F90 (rho00) + do k=1,levs + do i=1,im + ! check number of available ccn + IF ( nssl_ccn_on ) THEN + IF ( nssl_invertccn ) THEN + xccn = qccn - gq0(i,k,ntccn) ELSE - xcwmas = liqm + xccn = gq0(i,k,ntccn) ENDIF + ELSE + xccn = Max(0.0, qccn - gq0(i,k,ntlnc)) + ENDIF + + IF ( gq0(i,k,ntlnc) > 0.0 .and. save_qc(i,k) > 0.0 ) THEN + xcwmas = Max( liqm, gq0(i,k,ntcw)/gq0(i,k,ntlnc) ) + ELSE + xcwmas = liqm + ENDIF - IF ( gq0(i,k,ntinc) > 0.0 .and. save_qi(i,k) > 0.0 ) THEN - xcimas = Max( liqm, clw(i,k,1)/gq0(i,k,ntinc) ) - ELSE - xcimas = icem - ENDIF + IF ( gq0(i,k,ntinc) > 0.0 .and. save_qi(i,k) > 0.0 ) THEN + xcimas = Max( liqm, gq0(i,k,ntiw)/gq0(i,k,ntinc) ) + ELSE + xcimas = icem + ENDIF - IF ( xccn > 0.0 ) THEN - xccw = Min( xccn, max(0.0, (clw(i,k,2)-save_qc(i,k))) / xcwmas ) - gq0(i,k,ntlnc) = gq0(i,k,ntlnc) + xccw - IF ( nssl_ccn_on ) THEN - IF ( nssl_invertccn ) THEN - ! ccn are activated CCN, so add - gq0(i,k,ntccn) = gq0(i,k,ntccn) + xccw - ELSE - ! ccn are unactivated CCN, so subtract - gq0(i,k,ntccn) = gq0(i,k,ntccn) - xccw - ENDIF - ENDIF - ENDIF - - gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / xcimas - enddo + IF ( xccn > 0.0 ) THEN + xccw = Min( xccn, max(0.0, (gq0(i,k,ntcw)-save_qc(i,k))) / xcwmas ) + new_lnc(i,k) = new_lnc(i,k) + xccw + IF ( nssl_ccn_on ) THEN + IF ( nssl_invertccn ) THEN + ! ccn are activated CCN, so add + gq0(i,k,ntccn) = gq0(i,k,ntccn) + xccw + ELSE + ! ccn are unactivated CCN, so subtract + gq0(i,k,ntccn) = gq0(i,k,ntccn) - xccw + ENDIF + ENDIF + ENDIF + new_inc(i,k) = new_inc(i,k) & + + max(0.0, (gq0(i,k,ntiw)-save_qi(i,k))) / xcimas enddo - endif + enddo + endif - if ((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) .and. & - (ntlnc>0 .or. ntinc>0)) then - if_convert_dry_rho: if (convert_dry_rho) then - do k=1,levs - do i=1,im - !> - Convert specific humidity to dry mixing ratio - qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) - !> - Density of air in kg m-3 and inverse density - rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+con_eps)) - orho = one/rho - if (ntlnc>0) then - !> - Convert moist mixing ratio to dry mixing ratio - qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) - !> - Convert number concentration from moist to dry - nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) - if (imp_physics == imp_physics_thompson) then - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) - else - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) - endif - !> - Convert number concentrations from dry to moist - gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) + if ((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) .and. & + (ntlnc>0 .or. ntinc>0)) then + if_convert_dry_rho: if (convert_dry_rho) then + do k=1,levs + do i=1,im + !> - Convert specific humidity to dry mixing ratio + qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) + !> - Density of air in kg m-3 and inverse density + rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+con_eps)) + orho = one/rho + if (ntlnc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qc_mp(i,k) = (gq0(i,k,ntcw)-save_qc(i,k)) / (one-spechum(i,k)) + !> - Convert number concentration from moist to dry + nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) + if (imp_physics == imp_physics_thompson) then + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + else + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) endif - if (ntinc>0) then - !> - Convert moist mixing ratio to dry mixing ratio - qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) - !> - Convert number concentration from moist to dry - ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) - if (imp_physics == imp_physics_thompson) then - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) - else - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) - endif - !> - Convert number concentrations from dry to moist - gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) + !> - Convert number concentrations from dry to moist + new_lnc(i,k) = nc_mp(i,k) / (one+qv_mp(i,k)) + endif + if (ntinc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qi_mp(i,k) = (gq0(i,k,ntiw)-save_qi(i,k)) / (one-spechum(i,k)) + !> - Convert number concentration from moist to dry + ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) + if (imp_physics == imp_physics_thompson) then + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + else + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) endif - enddo + !> - Convert number concentrations from dry to moist + new_inc(i,k) = ni_mp(i,k) / (one+qv_mp(i,k)) + endif enddo - else - do k=1,levs - do i=1,im - !> - Density of air in kg m-3 and inverse density - rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+con_eps)) - orho = one/rho - if (ntlnc>0) then - !> - Update cloud water mixing ratio - qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) - !> - Update cloud water number concentration - if (imp_physics == imp_physics_thompson) then - gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) - else - gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) - endif + enddo + else + do k=1,levs + do i=1,im + !> - Density of air in kg m-3 and inverse density + rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+con_eps)) + orho = one/rho + if (ntlnc>0) then + !> - Update cloud water mixing ratio + qc_mp(i,k) = (gq0(i,k,ntcw)-save_qc(i,k)) + !> - Update cloud water number concentration + if (imp_physics == imp_physics_thompson) then + new_lnc(i,k) = max(zero, new_lnc(i,k) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + else + new_lnc(i,k) = max(zero, new_lnc(i,k) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) endif - if (ntinc>0) then - !> - Update cloud ice mixing ratio - qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) - !> - Update cloud ice number concentration - if (imp_physics == imp_physics_thompson) then - gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) - else - gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) - endif + endif + if (ntinc>0) then + !> - Update cloud ice mixing ratio + qi_mp(i,k) = (gq0(i,k,ntiw)-save_qi(i,k)) + !> - Update cloud ice number concentration + if (imp_physics == imp_physics_thompson) then + new_inc(i,k) = max(zero, new_inc(i,k) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + else + new_inc(i,k) = max(zero, new_inc(i,k) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) endif - enddo + endif enddo - end if if_convert_dry_rho - if(ldiag3d .and. qdiag3d) then - idtend = dtidx(100+ntlnc,index_of_process_conv_trans) - if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntlnc) - save_lnc - endif - idtend = dtidx(100+ntinc,index_of_process_conv_trans) - if(idtend>0) then - dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntinc) - save_inc - endif + enddo + end if if_convert_dry_rho + endif !Thompson MP + + if(ldiag3d .and. qdiag3d) then + if (ntlnc > 0) then + idtend = dtidx(100+ntlnc,index_of_process_conv_trans) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + new_lnc(:,:) - gq0(:,:,ntlnc) endif endif - - else - do k=1,levs - do i=1,im - gq0(i,k,ntcw) = clw(i,k,1) + clw(i,k,2) - enddo - enddo - endif ! end if_ntiw - - else - do k=1,levs - do i=1,im - clw(i,k,1) = clw(i,k,1) + clw(i,k,2) - enddo - enddo - endif ! end if_ntcw + if (ntinc > 0) then + idtend = dtidx(100+ntinc,index_of_process_conv_trans) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + new_inc(:,:) - gq0(:,:,ntinc) + endif + endif + endif + + if (ntlnc > 0) gq0(:,:,ntlnc) = new_lnc(:,:) + if (ntinc > 0) gq0(:,:,ntinc) = new_inc(:,:) + + endif ! end if_ntcw and if_ntiw end subroutine GFS_suite_interstitial_4_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta index 718b6ab95..15f9751f7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta @@ -231,22 +231,6 @@ type = real kind = kind_phys intent = in -[save_lnc] - standard_name = liquid_cloud_number_concentration_save - long_name = liquid cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[save_inc] - standard_name = ice_cloud_number_concentration_save - long_name = ice cloud number concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter @@ -256,7 +240,7 @@ kind = kind_phys intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -270,7 +254,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys - intent = inout + intent = in [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -321,7 +305,7 @@ intent = in optional = True [spechum] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -379,6 +363,20 @@ dimensions = () type = integer intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in [otsptflag] standard_name = flag_convective_tracer_transport_interstitial long_name = flag for interstitial tracer transport diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta index 511137901..3415538a8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta @@ -51,7 +51,7 @@ type = integer intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 deleted file mode 100644 index 313a0304c..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 +++ /dev/null @@ -1,43 +0,0 @@ -!> \file GFS_suite_stateout_reset.f90 -!! Contains code to set the values of the physics-updated state to the before-physics state prior to actually being modified by physics. - - module GFS_suite_stateout_reset - - contains - -!> \section arg_table_GFS_suite_stateout_reset_run Argument Table -!! \htmlinclude GFS_suite_stateout_reset_run.html -!! - subroutine GFS_suite_stateout_reset_run (im, levs, ntrac, & - tgrs, ugrs, vgrs, qgrs, & - gt0 , gu0 , gv0 , gq0 , & - errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - ! interface variables - integer, intent(in ) :: im - integer, intent(in ) :: levs - integer, intent(in ) :: ntrac - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 - real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - gt0(:,:) = tgrs(:,:) - gu0(:,:) = ugrs(:,:) - gv0(:,:) = vgrs(:,:) - gq0(:,:,:) = qgrs(:,:,:) - - end subroutine GFS_suite_stateout_reset_run - - end module GFS_suite_stateout_reset \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 deleted file mode 100644 index e5a20a77d..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ /dev/null @@ -1,66 +0,0 @@ -!> \file GFS_suite_stateout_update.f90 -!! Update the state variables due to process-split physics from accumulated tendencies -!! during that phase. -!! Update gas concentrations, if using prognostic photolysis schemes. -!! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. -module GFS_suite_stateout_update - use machine, only: kind_phys - implicit none - -contains - -!> \section arg_table_GFS_suite_stateout_update_run Argument Table -!! \htmlinclude GFS_suite_stateout_update_run.html -!! - subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & - dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, errmsg, errflg) - - ! Inputs - integer, intent(in ) :: im - integer, intent(in ) :: levs - integer, intent(in ) :: ntrac - integer, intent(in ) :: imp_physics,imp_physics_fer_hires - integer, intent(in ) :: ntiw, nqrimef - real(kind=kind_phys), intent(in ) :: dtp, epsq - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs - real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt - - ! Outputs - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 - real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Update prognostic state varaibles using accumulated tendencies from "process-split" - ! section of GFS suite. - gt0(:,:) = tgrs(:,:) + dtdt(:,:) * dtp - gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp - gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp - gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp - - ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. - if (imp_physics == imp_physics_fer_hires) then - do k=1,levs - do i=1,im - if(gq0(i,k,ntiw) > epsq) then - gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) - else - gq0(i,k,nqrimef) = 1. - end if - end do - end do - end if - - end subroutine GFS_suite_stateout_update_run - -end module GFS_suite_stateout_update diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index 6b601caa1..d1ebff9c1 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -153,7 +153,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature units = K dimensions = (horizontal_loop_extent) @@ -161,7 +161,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = surface layer mean specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta index d4824f3b0..1cadb0652 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta @@ -224,7 +224,7 @@ kind = kind_phys intent = inout [tgrs1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta index 5e7949b8f..ccc248c12 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta @@ -200,7 +200,7 @@ kind = kind_phys intent = in [tgrs_1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -208,7 +208,7 @@ kind = kind_phys intent = in [qgrs_1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) @@ -216,7 +216,7 @@ kind = kind_phys intent = in [ugrs_1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = zonal wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -224,7 +224,7 @@ kind = kind_phys intent = in [vgrs_1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = meridional wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index 33b7cdf8c..cd8ed8f09 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -418,7 +418,7 @@ kind = kind_phys intent = out [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = zonal wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -426,7 +426,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = meridional wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 index a159d899d..5ec068aaa 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 @@ -70,7 +70,8 @@ end subroutine GFS_time_vary_pre_finalize !! subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, & - kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) + kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, tgrs, ugrs, vgrs,& + qgrs, gt0 , gu0 , gv0 , gq0, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec @@ -88,7 +89,12 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, lslwr real(kind=kind_phys), intent(out) :: sec, phour, zhour, & fhour, julian, solhr - + + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -104,14 +110,20 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + ! Check initialization status if (.not.is_initialized) then write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called before GFS_time_vary_pre_init" errflg = 1 return end if - + + !--- set current state variables from timestep initial variables + gt0(:,:) = tgrs(:,:) + gu0(:,:) = ugrs(:,:) + gv0(:,:) = vgrs(:,:) + gq0(:,:,:) = qgrs(:,:,:) + !--- jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers call w3kind(w3kindreal, w3kindint) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta index bdf4ec8d5..057fc46cc 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta @@ -223,6 +223,70 @@ type = real kind = kind_phys intent = out +[tgrs] + standard_name = physics_timestep_initial_air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ugrs] + standard_name = physics_timestep_initial_x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = physics_timestep_initial_y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qgrs] + standard_name = physics_timestep_initial_tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 5f305d24f..c61f5836d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -67,7 +67,8 @@ end subroutine GFS_time_vary_pre_finalize !! subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & - julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) + julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, tgrs, ugrs, vgrs, qgrs, & + gt0 , gu0 , gv0 , gq0 , errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec @@ -86,6 +87,11 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & real(kind=kind_phys), intent(out) :: sec, phour, zhour, & fhour, julian, solhr + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -109,7 +115,13 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & errflg = 1 return end if - + + !--- set current state variables from timestep initial variables + gt0(:,:) = tgrs(:,:) + gu0(:,:) = ugrs(:,:) + gv0(:,:) = vgrs(:,:) + gq0(:,:,:) = qgrs(:,:,:) + !--- jdat is being updated directly inside of the time integration !--- loop of scm.F90 !--- update calendars and triggers diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta index 3bebfbe65..1027de17f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta @@ -216,6 +216,70 @@ type = real kind = kind_phys intent = out +[tgrs] + standard_name = physics_timestep_initial_air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ugrs] + standard_name = physics_timestep_initial_x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = physics_timestep_initial_y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qgrs] + standard_name = physics_timestep_initial_tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gu0] + standard_name = x_wind + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gv0] + standard_name = y_wind + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta index 3c91faaeb..af1bb995f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta @@ -78,7 +78,7 @@ type = logical intent = inout [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -86,7 +86,7 @@ kind = kind_phys intent = in [ugrs] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -94,7 +94,7 @@ kind = kind_phys intent = in [vgrs] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -102,7 +102,7 @@ kind = kind_phys intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -146,7 +146,7 @@ type = integer intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -154,7 +154,7 @@ kind = kind_phys intent = inout [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -162,7 +162,7 @@ kind = kind_phys intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -170,7 +170,7 @@ kind = kind_phys intent = inout [gq0] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f index 749f778c1..977371814 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f @@ -167,28 +167,30 @@ module dcyc2t3 !> @{ subroutine dcyc2t3_run & ! --- inputs: - & ( solhr,slag,sdec,cdec,sinlat,coslat, & + & ( lssav, ldiag3d, lsidea, solhr,slag,sdec,cdec,sinlat,coslat,& & con_g, con_cp, con_pi, con_sbc, & & xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat,tf,tsflw,tsfc, & & sfcemis_lnd, sfcemis_ice, sfcemis_wat, & & sfcdsw,sfcdswc,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & - & im, levs, deltim, fhswr, & + & im, levs, ntrac, deltim, delt, tend_opt_rad_scaler, fhswr, & & dry, icy, wet, damp_LW_fluxadj, lfnc_k, lfnc_p0, & & use_LW_jacobian, sfculw, use_med_flux, sfculw_med, & - & fluxlwUP_jac, t_lay, p_lay, p_lev, flux2D_lwUP, & + & fluxlwUP_jac, p_lay, p_lev, flux2D_lwUP, & & flux2D_lwDOWN,pert_radtend,do_sppt,ca_global,tsfc_radtime, & + & dtidx,index_of_process_longwave,index_of_process_shortwave,& + & index_of_temperature, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: - & dtdt,dtdtnp,htrlw, & + & dtdtnp,htrlw,dtend, & ! --- outputs: & adjsfcdsw,adjsfcdswc,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & - & errmsg,errflg & - & ) + & gu0, gv0, gt0, gq0, dudt, dvdt, dtdt, dqdt, ten_t, ten_u, & + & ten_v, ten_q, errmsg,errflg) ! use machine, only : kind_phys @@ -203,16 +205,16 @@ subroutine dcyc2t3_run & & czlimt = 0.0001_kind_phys ! ~ cos(89.99427) ! --- inputs: - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, ntrac, tend_opt_rad_scaler ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(:), intent(in) :: dry, icy, wet logical, intent(in) :: use_LW_jacobian, damp_LW_fluxadj, & - & pert_radtend, use_med_flux - logical, intent(in) :: do_sppt,ca_global + & pert_radtend, use_med_flux + logical, intent(in) :: do_sppt,ca_global,lssav,ldiag3d,lsidea real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, lfnc_k, lfnc_p0 + & deltim, delt, fhswr, lfnc_k, lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & @@ -228,7 +230,7 @@ subroutine dcyc2t3_run & & sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd real(kind=kind_phys), dimension(:,:), intent(in) :: swh, hlw, & - & swhc, hlwc, p_lay, t_lay + & swhc, hlwc, p_lay real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev real(kind=kind_phys), dimension(:,:), intent(in), optional :: & @@ -238,10 +240,14 @@ subroutine dcyc2t3_run & & con_pi, con_sbc real(kind_phys) :: pid12 - + real(kind_phys), optional, intent(inout), dimension(:,:,:) :: & + & dtend + integer, intent(in), dimension(:,:) :: dtidx + integer, intent(in) :: index_of_process_longwave, & + & index_of_process_shortwave, & + & index_of_temperature ! --- input/output: - real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdt real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & & dtdtnp, htrlw @@ -253,12 +259,20 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(:), intent(out) :: & & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat - + real(kind=kind_phys), dimension(:,:), intent(inout) :: gu0, gv0, & + & gt0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: dudt, dvdt,& + & dtdt + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dqdt + real(kind=kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u,& + & ten_v + real(kind=kind_phys), dimension(:,:,:), intent(out) :: ten_q character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals: - integer :: i, k, nstp, nstl, it, istsun(im),iSFC,iTOA + integer :: i, k, n, nstp, nstl, it, istsun(im),iSFC,iTOA,idtend real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & & rstl, solang, dT real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & @@ -277,7 +291,12 @@ subroutine dcyc2t3_run & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 + ! Vertical ordering? if (p_lev(1,1) .lt. p_lev(1, levs)) then iSFC = levs + 1 @@ -429,14 +448,14 @@ subroutine dcyc2t3_run & else lfnc = 1. endif - dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + & + ten_t(i,k) = swh(i,k)*xmu(i) + & & htrlw(i,k)*lfnc + (1.-lfnc)*hlw(i,k) enddo enddo else do k = 1, levs do i = 1, im - dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + hlw(i,k) + ten_t(i,k) = swh(i,k)*xmu(i) + hlw(i,k) enddo enddo endif @@ -458,7 +477,89 @@ subroutine dcyc2t3_run & enddo endif endif -! +! + case_rad_scaler_ten: select case (tend_opt_rad_scaler) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*ten_t(i,k) + gu0(i,k) = gu0(i,k) + delt*ten_u(i,k) + gv0(i,k) = gv0(i,k) + delt*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + delt*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + delt*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + delt*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + delt*(dqdt(i,k,n) + & + & ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_rad_scaler_ten + case default + errflg = 1 + write(errmsg,'(*(a))') 'A tendency application control was ', & + & ' outside of the acceptable range (1-4)' + return + end select case_rad_scaler_ten + + if (lssav .and. ldiag3d .and. .not. lsidea) then + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if(idtend>=1) then + if (use_LW_jacobian) then + do k=1,levs + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) + (ten_t(i,k) - & + & swh(i,k)*xmu(i))*deltim + end do + end do + else + dtend(:,:,idtend) = dtend(:,:,idtend) + hlw(:,:)*deltim + endif + endif + + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if(idtend>=1) then + do k=1,levs + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) & + & + swh(i,k)*xmu(i)*deltim + enddo + enddo + endif + end if + return !................................... end subroutine dcyc2t3_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta index bf6fb1a47..1d6456b33 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta @@ -7,6 +7,27 @@ [ccpp-arg-table] name = dcyc2t3_run type = scheme +[lssav] + standard_name = flag_for_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_for_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in +[lsidea] + standard_name = flag_for_integrated_dynamics_through_earths_atmosphere + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in [solhr] standard_name = forecast_utc_hour long_name = time in hours after 00z at the current timestep @@ -128,7 +149,7 @@ kind = kind_phys intent = in [tf] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = air temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -317,6 +338,13 @@ dimensions = () type = integer intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in [deltim] standard_name = timestep_for_dynamics long_name = dynamics timestep @@ -325,6 +353,21 @@ type = real kind = kind_phys intent = in +[delt] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[tend_opt_rad_scaler] + standard_name = control_for_application_method_of_radiation_timescaler_tendencies + long_name = control for application method of radiation timescaler tendencies + units = 1 + dimensions = () + type = integer + intent = in [fhswr] standard_name = period_of_shortwave_radiation_calls long_name = frequency for shortwave radiation @@ -417,14 +460,6 @@ kind = kind_phys intent = in optional = True -[t_lay] - standard_name = air_temperature_of_new_state - long_name = model layer mean temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [p_lay] standard_name = air_pressure long_name = mean layer pressure @@ -489,14 +524,34 @@ kind = kind_phys intent = in optional = True -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = total radiative heating rate at current time - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in [dtdtnp] standard_name = tendency_of_air_temperature_to_withold_from_sppt long_name = temp. change from physics that should not be perturbed by sppt @@ -515,6 +570,15 @@ kind = kind_phys intent = inout optional = True +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = True [adjsfcdsw] standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time @@ -651,6 +715,102 @@ type = real kind = kind_phys intent = out +[gu0] + standard_name = x_wind + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gt0] + standard_name = air_temperature + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta index 7108e2f97..d12b24d69 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta @@ -87,7 +87,7 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -280,7 +280,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta index 85bf403ad..fab67663c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta @@ -42,7 +42,7 @@ type = integer intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = x component of 1st model layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -50,7 +50,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = y component of 1st model layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -66,7 +66,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature units = K dimensions = (horizontal_loop_extent) @@ -74,7 +74,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = 1st model layer specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 index b4adf8719..8a0d669ee 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 @@ -78,11 +78,11 @@ subroutine sgscloud_radpre_run( & & imp_physics_gfdl, imp_physics_fa, conv_cf_opt logical, intent(in) :: flag_init, flag_restart, do_mynnedmf - real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi - real(kind=kind_phys), dimension(:,:), intent(inout) :: qr, qs, qg + real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi, qs + real(kind=kind_phys), dimension(:,:), intent(in) :: qr, qg ! note: qci_conv only allocated if GF is used - real(kind=kind_phys), dimension(:,:), intent(inout), optional :: qci_conv - real(kind=kind_phys), dimension(:,:), intent(inout) :: qlc, qli !for SAS + real(kind=kind_phys), dimension(:,:), intent(in), optional :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(in) :: qlc, qli !for SAS real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), dimension(:,:), intent(in) :: T3D,delp real(kind=kind_phys), dimension(:,:), intent(in) :: qv,P3D,exner diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index 57fa61dfe..2e9c2591b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -204,7 +204,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qg] standard_name = graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) @@ -212,7 +212,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt @@ -229,7 +229,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer @@ -238,7 +238,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qli] standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -246,7 +246,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [imfdeepcnv] standard_name = control_for_deep_convection_scheme long_name = flag for mass-flux deep convection scheme diff --git a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 index 1387dcbab..e524345d4 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 @@ -112,7 +112,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ,refl_10cm & ,RHGRD,dx & ,EPSQ,R_D,P608,CP,G & - ,errmsg,errflg) + ,ten_t,ten_qv,ten_ql,ten_qr,ten_qi,ten_qg & + ,ten_q,errmsg,errflg) !----------------------------------------------------------------------- USE MACHINE, ONLY: kind_phys @@ -138,19 +139,26 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(in ) :: prsi(:,:) real(kind_phys), intent(in ) :: p_phy(:,:) real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g - real(kind_phys), intent(inout) :: t(:,:) - real(kind_phys), intent(inout) :: q(:,:) + real(kind_phys), intent(in ) :: t(:,:) + real(kind_phys), intent(in ) :: q(:,:) real(kind_phys), intent(inout), optional :: train(:,:) real(kind_phys), intent(out ) :: sr(:) - real(kind_phys), intent(inout) :: qc(:,:) - real(kind_phys), intent(inout) :: qr(:,:) - real(kind_phys), intent(inout) :: qi(:,:) - real(kind_phys), intent(inout) :: qg(:,:) ! QRIMEF + real(kind_phys), intent(in ) :: qc(:,:) + real(kind_phys), intent(in ) :: qr(:,:) + real(kind_phys), intent(in ) :: qi(:,:) + real(kind_phys), intent(in ) :: qg(:,:) ! QRIMEF real(kind_phys), intent(inout) :: prec(:) real(kind_phys), intent(inout) :: refl_10cm(:,:) real(kind_phys), intent(in ) :: rhgrd real(kind_phys), intent(in ) :: dx(:) + real(kind_phys), intent( out) :: ten_t(:,:) + real(kind_phys), intent( out) :: ten_qv(:,:) + real(kind_phys), intent( out) :: ten_ql(:,:) + real(kind_phys), intent( out) :: ten_qr(:,:) + real(kind_phys), intent( out) :: ten_qi(:,:) + real(kind_phys), intent( out) :: ten_qg(:,:) + real(kind_phys), intent( out) :: ten_q(:,:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -171,6 +179,12 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys) :: f_rain(1:ncol,1:nlev) real(kind_phys) :: f_rimef(1:ncol,1:nlev) real(kind_phys) :: cwm(1:ncol,1:nlev) + real(kind_phys) :: new_t(1:ncol,1:nlev) + real(kind_phys) :: new_qv(1:ncol,1:nlev) + real(kind_phys) :: new_ql(1:ncol,1:nlev) + real(kind_phys) :: new_qr(1:ncol,1:nlev) + real(kind_phys) :: new_qi(1:ncol,1:nlev) + real(kind_phys) :: new_qg(1:ncol,1:nlev) ! Dimension integer :: ims, ime, lm @@ -181,7 +195,22 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - + + new_t = t + new_qv = q + new_ql = qc + new_qr = qr + new_qi = qi + new_qg = qg + + ten_t = 0.0 + ten_q = 0.0 !set tendency of entire tracer array to zero to make sure that those tracers not affected by this scheme do not change when tendencies are applied + ten_qv = 0.0 + ten_ql = 0.0 + ten_qr = 0.0 + ten_qi = 0.0 + ten_qg = 0.0 + ! Check initialization state if (.not. is_initialized) then write(errmsg, fmt='((a))') 'mp_fer_hires_run called before mp_fer_hires_init' @@ -235,19 +264,19 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !MZ* in HWRF !-- 6/11/2010: Update cwm, F_ice, F_rain and F_rimef arrays - cwm(I,K)=QC(I,K)+QR(I,K)+QI(I,K) - IF (QI(I,K) <= EPSQ) THEN + cwm(I,K)=new_ql(I,K)+new_qr(I,K)+new_qi(I,K) + IF (new_qi(I,K) <= EPSQ) THEN F_ICE(I,K)=0. F_RIMEF(I,K)=1. - IF (T(I,K) < T_ICEK) F_ICE(I,K)=1. + IF (new_t(I,K) < T_ICEK) F_ICE(I,K)=1. ELSE - F_ICE(I,K)=MAX( 0., MIN(1., QI(I,K)/cwm(I,K) ) ) - F_RIMEF(I,K)=QG(I,K)!/QI(I,K) + F_ICE(I,K)=MAX( 0., MIN(1., new_qi(I,K)/cwm(I,K) ) ) + F_RIMEF(I,K)=new_QG(I,K)!/QI(I,K) ENDIF - IF (QR(I,K) <= EPSQ) THEN + IF (new_qr(I,K) <= EPSQ) THEN F_RAIN(I,K)=0. ELSE - F_RAIN(I,K)=QR(I,K)/(QR(I,K)+QC(I,K)) + F_RAIN(I,K)=new_qr(I,K)/(new_qr(I,K)+new_ql(I,K)) ENDIF ENDDO @@ -258,10 +287,10 @@ 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)) + cwm(i,k) = cwm(i,k)/(1.0_kind_phys-new_q(i,k)) + new_qr(i,k) = new_qr(i,k)/(1.0_kind_phys-new_q(i,k)) + new_qi(i,k) = new_qi(i,k)/(1.0_kind_phys-new_q(i,k)) + new_ql(i,k) = new_ql(i,k)/(1.0_kind_phys-new_q(i,k)) ENDDO ENDDO !aligo @@ -269,12 +298,12 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & CALL FER_HIRES( & DT=DT,RHgrd=RHGRD & - ,PRSI=prsi,P_PHY=p_phy,T_PHY=t & - ,Q=Q,QT=cwm & + ,PRSI=prsi,P_PHY=p_phy,T_PHY=new_t & + ,Q=new_q,QT=cwm & ,LOWLYR=LOWLYR,SR=SR,TRAIN_PHY=train_phy & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN & ,F_RIMEF_PHY=F_RIMEF & - ,QC=QC,QR=QR,QS=QI & + ,QC=new_ql,QR=new_qr,QS=new_qi & ,RAINNC=rainnc,RAINNCV=rainncv & ,threads=threads & ,IMS=IMS,IME=IME,LM=LM & @@ -289,9 +318,9 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ! - Convert dry qc,qr,qi back to wet mixing ratio DO K = 1, LM DO I= IMS, IME - qc(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k)) - qi(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) - qr(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) + new_ql(i,k) = new_ql(i,k)/(1.0_kind_phys+new_q(i,k)) + new_qi(i,k) = new_qi(i,k)/(1.0_kind_phys+new_q(i,k)) + new_qr(i,k) = new_qr(i,k)/(1.0_kind_phys+new_q(i,k)) ENDDO ENDDO @@ -305,7 +334,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !MZ IF (SPEC_ADV) then - QG(I,K)=QI(I,K)*F_RIMEF(I,K) + new_QG(I,K)=new_qi(I,K)*F_RIMEF(I,K) + ten_qg(i,k) = (new_qg(i,k) - qg(i,k))/dt ENDIF ! @@ -313,6 +343,11 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING. !----------------------------------------------------------------------- ! + ten_t(i,k) = (new_t(i,k) - t(i,k))/dt + ten_qv(i,k) = (new_qv(i,k) - q(i,k))/dt + ten_ql(i,k) = (new_ql(i,k) - qc(i,k))/dt + ten_qr(i,k) = (new_qr(i,k) - qr(i,k))/dt + ten_qi(i,k) = (new_qi(i,k) - qi(i,k))/dt TRAIN(I,K)=TRAIN(I,K)+TRAIN_PHY(I,K) ENDDO ENDDO diff --git a/physics/MP/Ferrier_Aligo/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 0838bede2..3e5a6b35f 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta @@ -171,21 +171,21 @@ kind = kind_phys intent = in [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [train] standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme long_name = accumulated change of air temperature due to FA MP scheme @@ -204,37 +204,37 @@ kind = kind_phys intent = out [qc] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qr] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qi] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qg] - standard_name = mass_weighted_rime_factor_of_new_state + standard_name = mass_weighted_rime_factor long_name = mass weighted rime factor updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prec] standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation ( rain, ice, snow, graupel, ...) on physics timestep @@ -328,6 +328,62 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qv] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ql] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qg] + standard_name = tendency_of_mass_weighted_rime_factor + long_name = mass weighted rime factor tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 index 6314b3577..9a272f637 100644 --- a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 @@ -121,7 +121,8 @@ subroutine gfdl_cloud_microphys_run( rain0, ice0, snow0, graupel0, prcp0, sr, & dtp, hydrostatic, phys_hydrostatic, lradar, refl_10cm, & reset, effr_in, rew, rei, rer, res, reg, & - cplchm, pfi_lsan, pfl_lsan, errmsg, errflg) + cplchm, pfi_lsan, pfl_lsan, ten_t, ten_u, ten_v, ten_qv, ten_ql, ten_qr, & + ten_qi, ten_qs, ten_qg, ten_cldfrc, ten_q, errmsg, errflg) use machine, only: kind_phys @@ -140,9 +141,9 @@ subroutine gfdl_cloud_microphys_run( real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps, rainmin real(kind=kind_phys), intent(in ), dimension(:) :: frland, garea integer, intent(in ), dimension(:) :: islmsk - real(kind=kind_phys), intent(inout), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & + real(kind=kind_phys), intent(in ), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & gq0_ntsw, gq0_ntgl, gq0_ntclamt - real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0, gu0, gv0 real(kind=kind_phys), intent(in ), dimension(:,:) :: vvl, prsl, del real(kind=kind_phys), intent(in ), dimension(:,:) :: phii @@ -153,6 +154,9 @@ subroutine gfdl_cloud_microphys_run( real(kind_phys), intent(out ), dimension(:) :: graupel0 real(kind_phys), intent(out ), dimension(:) :: prcp0 real(kind_phys), intent(out ), dimension(:) :: sr + + real(kind_phys), intent(out ), dimension(:,:) :: ten_t, ten_u, ten_v, ten_qv, ten_ql, ten_qr, ten_qi, ten_qs, ten_qg, ten_cldfrc + real(kind_phys), intent(out ), dimension(:,:,:) :: ten_q real(kind_phys), intent(in) :: dtp ! physics time step logical, intent (in) :: hydrostatic, phys_hydrostatic @@ -173,7 +177,8 @@ subroutine gfdl_cloud_microphys_run( integer :: i, k, kk real(kind=kind_phys), dimension(1:im,1:levs) :: delp, dz, uin, vin, pt, qv1, ql1, qr1, qg1, qa1, qn1, qi1, & qs1, pt_dt, qa_dt, u_dt, v_dt, w, qv_dt, ql_dt, qr_dt, qi_dt, & - qs_dt, qg_dt, p123, refl + qs_dt, qg_dt, p123, refl, new_qv, new_ql, new_qi, new_qr, & + new_qs, new_qg, new_t real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls real(kind=kind_phys), dimension(:,:), allocatable :: den real(kind=kind_phys) :: onebg @@ -182,7 +187,19 @@ subroutine gfdl_cloud_microphys_run( ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 !set tendency of entire tracer array to zero to make sure that those tracers not affected by this scheme do not change when tendencies are applied + ten_qv = 0.0 + ten_ql = 0.0 + ten_qr = 0.0 + ten_qi = 0.0 + ten_qs = 0.0 + ten_qg = 0.0 + ten_cldfrc = 0.0 + iis = 1 iie = im jjs = 1 @@ -286,17 +303,28 @@ subroutine gfdl_cloud_microphys_run( do k=1,levs kk = levs-k+1 do i=1,im - gq0(i,k) = qv1(i,kk) + qv_dt(i,kk) * dtp - gq0_ntcw(i,k) = ql1(i,kk) + ql_dt(i,kk) * dtp - gq0_ntrw(i,k) = qr1(i,kk) + qr_dt(i,kk) * dtp - gq0_ntiw(i,k) = qi1(i,kk) + qi_dt(i,kk) * dtp - gq0_ntsw(i,k) = qs1(i,kk) + qs_dt(i,kk) * dtp - gq0_ntgl(i,k) = qg1(i,kk) + qg_dt(i,kk) * dtp - gq0_ntclamt(i,k) = qa1(i,kk) + qa_dt(i,kk) * dtp - gt0(i,k) = gt0(i,k) + pt_dt(i,kk) * dtp - gu0(i,k) = gu0(i,k) + u_dt(i,kk) * dtp - gv0(i,k) = gv0(i,k) + v_dt(i,kk) * dtp + ten_qv(i,k) = qv_dt(i,kk) + ten_ql(i,k) = ql_dt(i,kk) + ten_qr(i,k) = qr_dt(i,kk) + ten_qi(i,k) = qi_dt(i,kk) + ten_qs(i,k) = qs_dt(i,kk) + ten_qg(i,k) = qg_dt(i,kk) + ten_cldfrc(i,k) = qa_dt(i,kk) + + ten_t(i,k) = pt_dt(i,kk) + ten_u(i,k) = u_dt(i,kk) + ten_v(i,k) = v_dt(i,kk) + refl_10cm(i,k) = refl(i,kk) + + !new values needed for cloud_diagnosis below + new_qv(i,k) = qv1(i,kk) + qv_dt(i,kk) * dtp + new_ql(i,k) = ql1(i,kk) + ql_dt(i,kk) * dtp + new_qr(i,k) = qr1(i,kk) + qr_dt(i,kk) * dtp + new_qi(i,k) = qi1(i,kk) + qi_dt(i,kk) * dtp + new_qs(i,k) = qs1(i,kk) + qs_dt(i,kk) * dtp + new_qg(i,k) = qg1(i,kk) + qg_dt(i,kk) * dtp + new_t(i,k) = gt0(i,k) + pt_dt(i,kk) * dtp enddo enddo @@ -310,20 +338,20 @@ subroutine gfdl_cloud_microphys_run( enddo enddo endif - + if(effr_in) then allocate(den(1:im,1:levs)) do k=1,levs do i=1,im - den(i,k)=con_eps*prsl(i,k)/(con_rd*gt0(i,k)*(gq0(i,k)+con_eps)) + den(i,k)=con_eps*prsl(i,k)/(con_rd*new_t(i,k)*(new_qv(i,k)+con_eps)) enddo enddo call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), & del(1:im,1:levs), islmsk(1:im), & - gq0_ntcw(1:im,1:levs), gq0_ntiw(1:im,1:levs), & - gq0_ntrw(1:im,1:levs), & - gq0_ntsw(1:im,1:levs) + gq0_ntgl(1:im,1:levs), & - gq0_ntgl(1:im,1:levs)*0.0, gt0(1:im,1:levs), & + new_ql(1:im,1:levs), new_qi(1:im,1:levs), & + new_qr(1:im,1:levs), & + new_qs(1:im,1:levs) + new_qg(1:im,1:levs), & + new_qg(1:im,1:levs)*0.0, new_t(1:im,1:levs), & rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),& res(1:im,1:levs), reg(1:im,1:levs)) deallocate(den) diff --git a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta index 2b7db1961..35ee1c615 100644 --- a/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta @@ -193,85 +193,85 @@ type = integer intent = in [gq0] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntcw] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = cloud condensed water mixing ratio updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntrw] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = moist mixing ratio of rain updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntiw] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = moist mixing ratio of cloud ice updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntsw] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = moist mixing ratio of snow updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntgl] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntclamt] - standard_name = cloud_area_fraction_in_atmosphere_layer_of_new_state + standard_name = cloud_area_fraction_in_atmosphere_layer long_name = cloud fraction updated by physics units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = air temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vvl] standard_name = lagrangian_tendency_of_air_pressure long_name = layer mean vertical velocity @@ -473,6 +473,94 @@ kind = kind_phys intent = inout optional = True +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qv] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ql] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qs] + standard_name = tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qg] + standard_name = tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_cldfrc] + standard_name = tendency_of_cloud_area_fraction_in_atmosphere_layer + long_name = cloud fraction tendency + units = frac s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 index eae68d4f3..3ef8017b0 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 @@ -122,7 +122,9 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, rain0, ice0, snow0, graupel0, prcp0, sr, oro, & dtp, hydrostatic, lradar, refl_10cm, & reset, effr_in, rew, rei, rer, res, reg, & - cplchm, pfi_lsan, pfl_lsan, con_one, con_p001, con_secinday, errmsg, errflg) + cplchm, pfi_lsan, pfl_lsan, con_one, con_p001, con_secinday, ten_t, ten_u, & + ten_v, ten_qv, ten_ql, ten_qr, ten_qi, ten_qs, ten_qg, ten_cldfrc, ten_q, & + errmsg, errflg) use machine, only: kind_phys, kind_dyn, kind_dbl_prec @@ -133,10 +135,10 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps, rainmin real(kind=kind_phys), intent(in ) :: con_one, con_p001, con_secinday real(kind=kind_phys), intent(in ), dimension(:) :: garea, slmsk, snowd, oro - real(kind=kind_phys), intent(inout), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & + real(kind=kind_phys), intent(in ), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & gq0_ntsw, gq0_ntgl, gq0_ntclamt real(kind_phys), intent(in ), dimension(:,:,:) :: aerfld - real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0, gu0, gv0 real(kind=kind_phys), intent(in ), dimension(:,:) :: vvl, prsl, del real(kind=kind_phys), intent(in ), dimension(:,:) :: phii @@ -148,6 +150,9 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, real(kind_phys), intent(out ), dimension(:), optional :: graupel0 real(kind_phys), intent(out ), dimension(:) :: prcp0 real(kind_phys), intent(out ), dimension(:) :: sr + + real(kind_phys), intent(out ), dimension(:,:) :: ten_t, ten_u, ten_v, ten_qv, ten_ql, ten_qr, ten_qi, ten_qs, ten_qg, ten_cldfrc + real(kind_phys), intent(out ), dimension(:,:,:) :: ten_q real(kind_phys), intent(in) :: dtp ! physics time step logical, intent (in) :: hydrostatic, fast_mp_consv @@ -167,8 +172,7 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, integer :: iis, iie, jjs, jje, kks, kke, kbot, ktop integer :: i, k, kk real(kind=kind_phys), dimension(1:im,1:levs) :: delp, dz, uin, vin, pt, qv1, ql1, qi1, qr1, qs1, qg1, & - qa1, qnl, qni, pt_dt, qa_dt, u_dt, v_dt, w, qv_dt, ql_dt,& - qr_dt, qi_dt, qs_dt, qg_dt, p123, refl + qa1, qnl, qni, w, p123, refl real(kind=kind_phys), dimension(1:im,1:levs) :: q_con, cappa !for inline MP option real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls real(kind=kind_phys), dimension(1:im,1,1:levs) :: adj_vmr, te @@ -180,11 +184,24 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, real(kind=kind_phys) :: onebg real(kind=kind_phys) :: tem logical last_step, do_inline_mp + real(kind=kind_phys), dimension(:,:), allocatable :: new_qv, new_ql, new_qi, new_qr, new_qs, new_qg, new_qa, new_t ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 !set tendency of entire tracer array to zero to make sure that those tracers not affected by this scheme do not change when tendencies are applied + ten_qv = 0.0 + ten_ql = 0.0 + ten_qr = 0.0 + ten_qi = 0.0 + ten_qs = 0.0 + ten_qg = 0.0 + ten_cldfrc = 0.0 + iis = 1 iie = im jjs = 1 @@ -200,19 +217,7 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, do k = 1, levs kk = levs-k+1 do i = 1, im - qv_dt(i,k) = 0.0 - ql_dt(i,k) = 0.0 - qr_dt(i,k) = 0.0 - qi_dt(i,k) = 0.0 - qs_dt(i,k) = 0.0 - qg_dt(i,k) = 0.0 - qa_dt(i,k) = 0.0 - pt_dt(i,k) = 0.0 - u_dt(i,k) = 0.0 - v_dt(i,k) = 0.0 qnl(i,k) = aerfld(i,kk,11) ! sulfate - pfils(i,1,k) = 0.0 - pflls(i,1,k) = 0.0 prefluxw(i,k) =0.0 prefluxi(i,k) =0.0 prefluxr(i,k) =0.0 @@ -307,16 +312,16 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, do k=1,levs kk = levs-k+1 do i=1,im - gq0(i,k) = qv1(i,kk) - gq0_ntcw(i,k) = ql1(i,kk) - gq0_ntrw(i,k) = qr1(i,kk) - gq0_ntiw(i,k) = qi1(i,kk) - gq0_ntsw(i,k) = qs1(i,kk) - gq0_ntgl(i,k) = qg1(i,kk) - gq0_ntclamt(i,k) = qa1(i,kk) - gt0(i,k) = pt(i,kk) - gu0(i,k) = uin(i,kk) - gv0(i,k) = vin(i,kk) + ten_qv(i,k) = (qv1(i,kk) - gq0(i,kk))/dtp + ten_ql(i,k) = (ql1(i,kk) - gq0_ntcw(i,k))/dtp + ten_qr(i,k) = (qr1(i,kk) - gq0_ntrw(i,k))/dtp + ten_qi(i,k) = (qi1(i,kk) - gq0_ntiw(i,k))/dtp + ten_qs(i,k) = (qs1(i,kk) - gq0_ntsw(i,k))/dtp + ten_qg(i,k) = (qg1(i,kk) - gq0_ntgl(i,k))/dtp + ten_cldfrc(i,k) = (qa1(i,kk) - gq0_ntclamt(i,k))/dtp + ten_t(i,k) = (pt(i,kk) - gt0(i,k))/dtp + ten_u(i,k) = (uin(i,kk) - gu0(i,k))/dtp + ten_v(i,k) = (vin(i,kk) - gv0(i,k))/dtp refl_10cm(i,k) = refl(i,kk) enddo enddo @@ -333,19 +338,34 @@ subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, endif if(effr_in) then + allocate(new_qv(im,levs), new_ql(im,levs), new_qi(im,levs), new_qr(im,levs), new_qs(im,levs), new_qg(im,levs), new_qa(im,levs), new_t(im,levs)) + do k=1,levs + kk = levs-k+1 + do i=1,im + new_qv(i,k) = qv1(i,kk) + new_ql(i,k) = ql1(i,kk) + new_qr(i,k) = qr1(i,kk) + new_qi(i,k) = qi1(i,kk) + new_qs(i,k) = qs1(i,kk) + new_qg(i,k) = qg1(i,kk) + new_qa(i,k) = qa1(i,kk) + new_t(i,k) = pt(i,kk) + enddo + enddo + call cld_eff_rad (1, im, 1, levs, slmsk(1:im), & prsl(1:im,1:levs), del(1:im,1:levs), & - gt0(1:im,1:levs), gq0(1:im,1:levs), & - gq0_ntcw(1:im,1:levs), gq0_ntiw(1:im,1:levs), & - gq0_ntrw(1:im,1:levs), gq0_ntsw(1:im,1:levs), & - gq0_ntgl(1:im,1:levs), gq0_ntclamt(1:im,1:levs), & + new_t(1:im,1:levs), new_qv(1:im,1:levs), & + new_ql(1:im,1:levs), new_qi(1:im,1:levs), & + new_qr(1:im,1:levs), new_qs(1:im,1:levs), & + new_qg(1:im,1:levs), new_qa(1:im,1:levs), & rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),& res(1:im,1:levs), reg(1:im,1:levs),snowd(1:im)) endif if(lradar) then call rad_ref (1, im, 1, 1, qv1(1:im,1:levs), qr1(1:im,1:levs), & - qs1(1:im,1:levs),qg1(1:im,1:levs),pt(1:im,1:levs), & + qs1(1:im,1:levs),qg1(1:im,1:levs),pt(1:im,1:levs), & delp(1:im,1:levs), dz(1:im,1:levs), refl(1:im,1:levs), levs, hydrostatic, & do_inline_mp, 1) diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta index 3b022bf25..25abe46c1 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta @@ -207,61 +207,61 @@ kind = kind_phys intent = in [gq0] - standard_name = specific_humidity_of_new_state - long_name = water vapor specific humidity updated by physics + standard_name = specific_humidity + long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntcw] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state - long_name = cloud condensed water mixing ratio updated by physics + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntrw] - standard_name = rain_mixing_ratio_of_new_state - long_name = moist mixing ratio of rain updated by physics + standard_name = rain_mixing_ratio + long_name = moist mixing ratio of rain units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntiw] - standard_name = cloud_ice_mixing_ratio_of_new_state - long_name = moist mixing ratio of cloud ice updated by physics + standard_name = cloud_ice_mixing_ratio + long_name = moist mixing ratio of cloud ice units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntsw] - standard_name = snow_mixing_ratio_of_new_state - long_name = moist mixing ratio of snow updated by physics + standard_name = snow_mixing_ratio + long_name = moist mixing ratio of snow units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntgl] - standard_name = graupel_mixing_ratio_of_new_state - long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + standard_name = graupel_mixing_ratio + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0_ntclamt] - standard_name = cloud_area_fraction_in_atmosphere_layer_of_new_state - long_name = cloud fraction updated by physics + standard_name = cloud_area_fraction_in_atmosphere_layer + long_name = cloud fraction units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [aerfld] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -271,29 +271,29 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state - long_name = air temperature updated by physics + standard_name = air_temperature + long_name = air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics + standard_name = x_wind + long_name = zonal wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics + standard_name = y_wind + long_name = meridional wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vvl] standard_name = lagrangian_tendency_of_air_pressure long_name = layer mean vertical velocity @@ -524,6 +524,94 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qv] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ql] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qs] + standard_name = tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qg] + standard_name = tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_cldfrc] + standard_name = tendency_of_cloud_area_fraction_in_atmosphere_layer + long_name = cloud fraction tendency + units = frac s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/Morrison_Gettelman/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 index 1cc866689..9054b42ee 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro.F90 @@ -150,18 +150,21 @@ subroutine m_micro_run( im, lm, flipv, dt_i & &, CNV_DQLDT_i, CLCN_i, u_i, v_i & &, TAUGWX, TAUGWY & &, TAUOROX, TAUOROY, CNV_FICE_i & - &, CNV_NDROP_i,CNV_NICE_i, q_io, lwm_o & - &, qi_o, t_io, rn_o, sr_o & - &, ncpl_io, ncpi_io, fprcp, rnw_io, snw_io& - &, qgl_io, ncpr_io, ncps_io, ncgl_io & + &, CNV_NDROP_i,CNV_NICE_i, q_i & + &, t_i , rn_o, sr_o & + &, ncpl_i, ncpi_i, fprcp, rnw_i, snw_i & + &, qgl_i, ncpr_i, ncps_i, ncgl_i & &, CLLS_io, KCBL, rainmin & &, CLDREFFL, CLDREFFI, CLDREFFR, CLDREFFS & &, CLDREFFG, ntrcaer, aerfld_i & &, naai_i, npccn_i, iccn & &, skip_macro & &, alf_fac, qc_min, pdfflag & - &, kdt, xlat, xlon, rhc_i, & - & errmsg, errflg) + &, kdt, xlat, xlon, rhc_i & + &, ten_t, ten_q, ten_qv, ten_ncpi & + &, ten_ncpl, ten_rnw, ten_snw, ten_qgl & + &, ten_ncpr, ten_ncps, ten_ncgl, ten_ql & + &, ten_qi, errmsg, errflg) ! use funcphys, only: fpvs !< saturation vapor pressure for water-ice mixed ! use funcphys, only: fpvsl, fpvsi, fpvs !< saturation vapor pressure for water,ice & mixed @@ -203,7 +206,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & & CNV_NICE_i, w_upi -! *GJF + real (kind=kind_phys), dimension(:,:),intent(in) :: & & rhc_i, naai_i, npccn_i real (kind=kind_phys), dimension(:,:,:),intent(in) :: & @@ -214,7 +217,6 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! & CNVPRCP ! output - real (kind=kind_phys),dimension(:,:), intent(out) :: lwm_o, qi_o real (kind=kind_phys),dimension(:,:), intent(out) :: & cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(:), intent(out) :: rn_o, sr_o @@ -224,12 +226,13 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! input and output ! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose integer, dimension(:), intent(inout):: KCBL - real (kind=kind_phys),dimension(:,:),intent(inout):: q_io, t_io, & - & ncpi_io + real (kind=kind_phys),dimension(:,:),intent(in):: q_i, t_i, & + & ncpi_i real (kind=kind_phys),dimension(:,:),intent(inout) :: & - rnw_io, snw_io, ncpr_io, ncps_io, qgl_io, ncgl_io, ncpl_io, & CLLS_io -! *GJF + real (kind=kind_phys),dimension(:,:),intent(in) :: ncpl_i, rnw_i, snw_i, qgl_i, ncpr_i, ncps_i, ncgl_i + real (kind=kind_phys),dimension(:,:), intent(out) :: ten_t, ten_qv, ten_ncpi, ten_ncpl, ten_rnw, ten_snw, ten_qgl, ten_ncpr, ten_ncps, ten_ncgl, ten_ql, ten_qi + real (kind=kind_phys),dimension(:,:,:), intent(out) :: ten_q !Moo real (kind=kind_phys),dimension(im,lm),intent(inout):: CLLS_io @@ -411,6 +414,19 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ten_t = 0.0 + ten_q = 0.0 + ten_qv = 0.0 + ten_ncpi = 0.0 + ten_rnw = 0.0 + ten_snw = 0.0 + ten_qgl = 0.0 + ten_ncpr = 0.0 + ten_ncps = 0.0 + ten_ncgl = 0.0 + ten_ql = 0.0 + ten_qi = 0.0 lprnt = .false. ipr = 1 @@ -421,18 +437,18 @@ subroutine m_micro_run( im, lm, flipv, dt_i & DO K=1, LM ll = lm-k+1 DO I = 1,IM - Q1(i,k) = q_io(i,ll) + Q1(i,k) = q_i(i,ll) U1(i,k) = u_i(i,ll) V1(i,k) = v_i(i,ll) omega(i,k) = omega_i(i,ll) - ncpl(i,k) = ncpl_io(i,ll) - ncpi(i,k) = ncpi_io(i,ll) - rnw(i,k) = rnw_io(i,ll) - snw(i,k) = snw_io(i,ll) - qgl(i,k) = qgl_io(i,ll) - ncpr(i,k) = ncpr_io(i,ll) - ncps(i,k) = ncps_io(i,ll) - ncgl(i,k) = ncgl_io(i,ll) + ncpl(i,k) = ncpl_i(i,ll) + ncpi(i,k) = ncpi_i(i,ll) + rnw(i,k) = rnw_i(i,ll) + snw(i,k) = snw_i(i,ll) + qgl(i,k) = qgl_i(i,ll) + ncpr(i,k) = ncpr_i(i,ll) + ncps(i,k) = ncps_i(i,ll) + ncgl(i,k) = ncgl_i(i,ll) ! QLLS is the total cloud water QLLS(i,k) = QLLS_i(i,ll)-QLCN_i(i,ll) QLCN(i,k) = QLCN_i(i,ll) @@ -445,7 +461,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) PLO(i,k) = prsl_i(i,ll)*0.01_kp zlo(i,k) = phil(i,ll) * onebg - temp(i,k) = t_io(i,ll) + temp(i,k) = t_i(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) rhc(i,k) = rhc_i(i,ll) if (iccn == 1) then @@ -481,18 +497,18 @@ subroutine m_micro_run( im, lm, flipv, dt_i & else DO K=1, LM DO I = 1,IM - Q1(i,k) = q_io(i,k) + Q1(i,k) = q_i(i,k) U1(i,k) = u_i(i,k) V1(i,k) = v_i(i,k) omega(i,k) = omega_i(i,k) - ncpl(i,k) = ncpl_io(i,k) - ncpi(i,k) = ncpi_io(i,k) - rnw(i,k) = rnw_io(i,k) - snw(i,k) = snw_io(i,k) - qgl(i,k) = qgl_io(i,k) - ncpr(i,k) = ncpr_io(i,k) - ncps(i,k) = ncps_io(i,k) - ncgl(i,k) = ncgl_io(i,k) + ncpl(i,k) = ncpl_i(i,k) + ncpi(i,k) = ncpi_i(i,k) + rnw(i,k) = rnw_i(i,k) + snw(i,k) = snw_i(i,k) + qgl(i,k) = qgl_i(i,k) + ncpr(i,k) = ncpr_i(i,k) + ncps(i,k) = ncps_i(i,k) + ncgl(i,k) = ncgl_i(i,k) ! QLLS is the total cloud water QLLS(i,k) = QLLS_i(i,k)-QLCN_i(i,k) QLCN(i,k) = QLCN_i(i,k) @@ -505,7 +521,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) PLO(i,k) = prsl_i(i,k)*0.01_kp zlo(i,k) = phil(i,k) * onebg - temp(i,k) = t_io(i,k) + temp(i,k) = t_i(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) rhc(i,k) = rhc_i(i,k) if (iccn == 1) then @@ -1798,18 +1814,18 @@ subroutine m_micro_run( im, lm, flipv, dt_i & DO K=1, LM ll = lm-k+1 DO I = 1,IM - t_io(i,k) = TEMP(i,ll) - q_io(i,k) = Q1(i,ll) - ncpi_io(i,k) = NCPI(i,ll) - ncpl_io(i,k) = NCPL(i,ll) - rnw_io(i,k) = rnw(i,ll) - snw_io(i,k) = snw(i,ll) - qgl_io(i,k) = qgl(i,ll) - ncpr_io(i,k) = NCPR(i,ll) - ncps_io(i,k) = NCPS(i,ll) - ncgl_io(i,k) = NCGL(i,ll) - lwm_o(i,k) = QL_TOT(i,ll) - qi_o(i,k) = QI_TOT(i,ll) + ten_t(i,k) = (temp(i,ll) - t_i(i,k))/dt_i + ten_qv(i,k) = (Q1(i,ll) - q_i(i,k))/dt_i + ten_ncpi(i,k) = (ncpi(i,ll) - ncpi_i(i,k))/dt_i + ten_ncpl(i,k) = (ncpl(i,ll) - ncpl_i(i,k))/dt_i + ten_rnw(i,k) = (rnw(i,ll) - rnw_i(i,k))/dt_i + ten_snw(i,k) = (snw(i,ll) - snw_i(i,k))/dt_i + ten_qgl(i,k) = (qgl(i,ll) - qgl_i(i,k))/dt_i + ten_ncpr(i,k) = (ncpr(i,ll) - ncpr_i(i,k))/dt_i + ten_ncps(i,k) = (ncps(i,ll) - ncps_i(i,k))/dt_i + ten_ncgl(i,k) = (ncgl(i,ll) - ncgl_i(i,k))/dt_i + ten_ql(i,k) = (ql_tot(i,ll) - qlls_i(i,k))/dt_i + ten_qi(i,k) = (qi_tot(i,ll) - qils_i(i,k))/dt_i END DO END DO if (skip_macro) then @@ -1830,18 +1846,18 @@ subroutine m_micro_run( im, lm, flipv, dt_i & else DO K=1, LM DO I = 1,IM - t_io(i,k) = TEMP(i,k) - q_io(i,k) = Q1(i,k) - ncpi_io(i,k) = NCPI(i,k) - ncpl_io(i,k) = NCPL(i,k) - rnw_io(i,k) = rnw(i,k) - snw_io(i,k) = snw(i,k) - qgl_io(i,k) = qgl(i,k) - ncpr_io(i,k) = NCPR(i,k) - ncps_io(i,k) = NCPS(i,k) - ncgl_io(i,k) = NCGL(i,k) - lwm_o(i,k) = QL_TOT(i,k) - qi_o(i,k) = QI_TOT(i,k) + ten_t(i,k) = (temp(i,k) - t_i(i,k))/dt_i + ten_qv(i,k) = (Q1(i,k) - q_i(i,k))/dt_i + ten_ncpi(i,k) = (ncpi(i,k) - ncpi_i(i,k))/dt_i + ten_ncpl(i,k) = (ncpl(i,k) - ncpl_i(i,k))/dt_i + ten_rnw(i,k) = (rnw(i,k) - rnw_i(i,k))/dt_i + ten_snw(i,k) = (snw(i,k) - snw_i(i,k))/dt_i + ten_qgl(i,k) = (qgl(i,k) - qgl_i(i,k))/dt_i + ten_ncpr(i,k) = (ncpr(i,k) - ncpr_i(i,k))/dt_i + ten_ncps(i,k) = (ncps(i,k) - ncps_i(i,k))/dt_i + ten_ncgl(i,k) = (ncgl(i,k) - ncgl_i(i,k))/dt_i + ten_ql(i,k) = (ql_tot(i,k) - qlls_i(i,k))/dt_i + ten_qi(i,k) = (qi_tot(i,k) - qils_i(i,k))/dt_i END DO END DO if (skip_macro) then @@ -1874,7 +1890,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! if (lprnt) then ! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr),' kdt=',kdt -! write(0,*)' end micro_mg_tend t_io= ', t_io(ipr,:) +! write(0,*)' end micro_mg_tend t_i= ', t_i(ipr,:) ! write(0,*)' end micro_mg_tend clls_io= ', clls_io(ipr,:) ! endif ! do k=1,lm diff --git a/physics/MP/Morrison_Gettelman/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta index 16efc5cc4..bcc15a92a 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -380,8 +380,8 @@ kind = kind_phys intent = in [qlls_i] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + standard_name = cloud_liquid_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -396,8 +396,8 @@ kind = kind_phys intent = in [qils_i] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + standard_name = cloud_ice_mixing_ratio + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -484,7 +484,7 @@ kind = kind_phys intent = in [u_i] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -492,7 +492,7 @@ kind = kind_phys intent = in [v_i] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -555,38 +555,22 @@ type = real kind = kind_phys intent = in -[q_io] - standard_name = specific_humidity_of_new_state +[q_i] + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[lwm_o] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[qi_o] - standard_name = cloud_ice_mixing_ratio_of_new_state - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[t_io] - standard_name = air_temperature_of_new_state + intent = in +[t_i] + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [rn_o] standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep @@ -603,22 +587,22 @@ type = real kind = kind_phys intent = out -[ncpl_io] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state +[ncpl_i] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = number concentration of cloud droplets updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[ncpi_io] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state + intent = in +[ncpi_i] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = number concentration of ice updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [fprcp] standard_name = number_of_frozen_precipitation_species long_name = number of frozen precipitation species @@ -626,54 +610,54 @@ dimensions = () type = integer intent = in -[rnw_io] - standard_name = local_rain_water_mixing_ratio - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics +[rnw_i] + standard_name = rain_mixing_ratio + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[snw_io] - standard_name = local_snow_water_mixing_ratio - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics + intent = in +[snw_i] + standard_name = snow_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[qgl_io] - standard_name = local_graupel_mixing_ratio - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics + intent = in +[qgl_i] + standard_name = graupel_mixing_ratio + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[ncpr_io] - standard_name = local_rain_number_concentration - long_name = number concentration of rain local to physics + intent = in +[ncpr_i] + standard_name = mass_number_concentration_of_rain + long_name = number concentration of rain updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[ncps_io] - standard_name = local_snow_number_concentration - long_name = number concentration of snow local to physics + intent = in +[ncps_i] + standard_name = mass_number_concentration_of_snow + long_name = number concentration of snow updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout -[ncgl_io] - standard_name = local_graupel_number_concentration - long_name = number concentration of graupel local to physics + intent = in +[ncgl_i] + standard_name = mass_number_concentration_of_graupel + long_name = number concentration of graupel updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [clls_io] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -828,6 +812,110 @@ type = real kind = kind_phys intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[ten_qv] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ncpi] + standard_name = tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ncpl] + standard_name = tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_rnw] + standard_name = tendency_of_rain_mixing_ratio + long_name = tendency of ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_snw] + standard_name = tendency_of_snow_mixing_ratio + long_name = tendency of ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qgl] + standard_name = tendency_of_graupel_mixing_ratio + long_name = tendency of ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ncpr] + standard_name = tendency_of_mass_number_concentration_of_rain_water_in_air + long_name = number concentration of rain tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ncps] + standard_name = tendency_of_mass_number_concentration_of_snow + long_name = number concentration of snow tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ncgl] + standard_name = tendency_of_mass_number_concentration_of_graupel + long_name = number concentration of graupel tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_ql] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/Morrison_Gettelman/m_micro_post.F90 b/physics/MP/Morrison_Gettelman/m_micro_post.F90 index a61ee4874..21c4affae 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_post.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro_post.F90 @@ -12,9 +12,9 @@ module m_micro_post !! \htmlinclude m_micro_post_run.html !! subroutine m_micro_post_run( & - im, levs, fprcp, mg3_as_mg2, ncpr, ncps, ncgl, qrn, qsnw, qgl, & - gq0_ice, gq0_rain, gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, & - gq0_graupel_nc, ice, snow, graupel, dtp, errmsg, errflg) + im, levs, fprcp, mg3_as_mg2, & + gq0_ice, gq0_rain, gq0_snow, gq0_graupel, ten_qi, ten_qr, ten_qs, ten_qg, & + ice, snow, graupel, dtp, errmsg, errflg) use machine, only : kind_phys implicit none @@ -22,19 +22,14 @@ subroutine m_micro_post_run( & integer, intent(in) :: im, levs, fprcp logical, intent(in) :: mg3_as_mg2 - real(kind=kind_phys), intent(in ) :: ncpr(:,:) - real(kind=kind_phys), intent(in ) :: ncps(:,:) - real(kind=kind_phys), intent(in ) :: ncgl(:,:) - real(kind=kind_phys), intent(inout) :: qrn(:,:) - real(kind=kind_phys), intent(inout) :: qsnw(:,:) - real(kind=kind_phys), intent(inout) :: qgl(:,:) real(kind=kind_phys), intent(in ) :: gq0_ice(:,:) - real(kind=kind_phys), intent(out ) :: gq0_rain(:,:) - real(kind=kind_phys), intent(out ) :: gq0_snow(:,:) - real(kind=kind_phys), intent(out ) :: gq0_graupel(:,:) - real(kind=kind_phys), intent(out ) :: gq0_rain_nc(:,:) - real(kind=kind_phys), intent(out ) :: gq0_snow_nc(:,:) - real(kind=kind_phys), intent(out ) :: gq0_graupel_nc(:,:) + real(kind=kind_phys), intent(in ) :: gq0_rain(:,:) + real(kind=kind_phys), intent(in ) :: gq0_snow(:,:) + real(kind=kind_phys), intent(in ) :: gq0_graupel(:,:) + real(kind=kind_phys), intent(in ) :: ten_qi(:,:) + real(kind=kind_phys), intent(inout) :: ten_qr(:,:) + real(kind=kind_phys), intent(inout) :: ten_qs(:,:) + real(kind=kind_phys), intent(inout) :: ten_qg(:,:) real(kind=kind_phys), intent( out) :: ice(:) real(kind=kind_phys), intent( out) :: snow(:) real(kind=kind_phys), intent( out) :: graupel(:) @@ -48,80 +43,79 @@ subroutine m_micro_post_run( & real(kind=kind_phys), parameter :: con_p001 = 0.001d0 real(kind=kind_phys), parameter :: con_day = 86400.0d0 integer :: i, k - real(kind=kind_phys) :: tem + real(kind=kind_phys) :: tem, new_qi, new_qr, new_qs, new_qg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 -! do k=1,levs -! write(1000+me,*)' maxwatnca=',maxval(Stateout%gq0(1:im,k,ntlnc)),' k=',k,' kdt=',kdt -! enddo -! write(1000+me,*)' at latitude = ',lat -! tx1 = 1000.0 -! call moist_bud(im,ix,ix,levs,me,kdt,con_g,tx1,del,rain1 -! &, txa, clw(1,1,2), clw(1,1,1) -! &, gq0(1,1,1),gq0(1,1,ntcw),gq0(1,1,ntcw+1),' m_micro ') - -! if (lprnt) write(0,*) ' rain1=',rain1(ipr)*86400.0, & -! &' rainc=',diag%rainc(ipr)*86400.0 -! &,' cn_prc=',cn_prc(ipr),' cn_snr=',cn_snr(ipr) -! if(lprnt) write(0,*) ' aftgt0=',Stateout%gt0(ipr,:),' kdt=',kdt -! if (lprnt) write(0,*) ' aftlsgq0=',stateout%gq0(ipr,:,1),' kdt=',kdt -! if (lprnt) write(0,*)' clw1aft=',stateout%gq0(ipr,:,ntiw),' kdt=',kdt -! if (ntgl > 0 .and. lprnt) & -! write(0,*)' cgw1aft=',stateout%gq0(ipr,:,ntgl),' kdt=',kdt -! if (lprnt) write(0,*)' cloudsm=',tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt -! if (lprnt) write(0,*)' clw2aft=',stateout%gq0(ipr,:,ntcw),' kdt=',kdt -! if (lprnt) write(0,*)' qrna=',qrn(ipr,:),' kdt=',kdt -! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt -! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt tem = dtp * con_p001 / con_day if (abs(fprcp) == 1 .or. mg3_as_mg2) then do k=1,levs do i=1,im - if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 - if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) - gq0_rain_nc(i,k) = ncpr(i,k) - gq0_snow_nc(i,k) = ncps(i,k) + new_qr = gq0_rain(i,k) + dtp*ten_qr(i,k) + !zero out qr when tendencies are applied if after-application value is small or negative + if (new_qr < 0) then + ten_qr(i,k) = new_qr/dtp + else if (new_qr < qsmall) then + ten_qr(i,k) = ten_qr(i,k) - new_qr/dtp + end if + + new_qs = gq0_snow(i,k) + dtp*ten_qs(i,k) + !zero out qs when tendencies are applied if after-application value is small or negative + if (new_qs < 0) then + ten_qs(i,k) = new_qs/dtp + else if (new_qs < qsmall) then + ten_qs(i,k) = ten_qs(i,k) - new_qs/dtp + end if enddo enddo do i=1,im - ice(i) = tem * gq0_ice(i,1) - snow(i) = tem * qsnw(i,1) + new_qi = gq0_ice(i,1) + dtp*ten_qi(i,1) + ice(i) = tem * new_qi + new_qs = gq0_snow(i,1) + dtp*ten_qs(i,1) + snow(i) = tem * new_qs enddo elseif (fprcp > 1) then do k=1,levs do i=1,im - if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 - if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 - if (abs(qgl(i,k)) < qsmall) qgl(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) - gq0_graupel(i,k) = qgl(i,k) - gq0_rain_nc(i,k) = ncpr(i,k) - gq0_snow_nc(i,k) = ncps(i,k) - gq0_graupel_nc(i,k) = ncgl(i,k) + new_qr = gq0_rain(i,k) + dtp*ten_qr(i,k) + !zero out qr when tendencies are applied if after-application value is small or negative + if (new_qr < 0) then + ten_qr(i,k) = new_qr/dtp + else if (new_qr < qsmall) then + ten_qr(i,k) = ten_qr(i,k) - new_qr/dtp + end if + + new_qs = gq0_snow(i,k) + dtp*ten_qs(i,k) + !zero out qs when tendencies are applied if after-application value is small or negative + if (new_qs < 0) then + ten_qs(i,k) = new_qs/dtp + else if (new_qs < qsmall) then + ten_qs(i,k) = ten_qs(i,k) - new_qs/dtp + end if + + + new_qg = gq0_graupel(i,k) + dtp*ten_qg(i,k) + !zero out qg when tendencies are applied if after-application value is small or negative + if (new_qg < 0) then + ten_qg(i,k) = new_qg/dtp + else if (new_qg < qsmall) then + ten_qg(i,k) = ten_qg(i,k) - new_qg/dtp + end if enddo enddo do i=1,im - ice(i) = tem * gq0_ice(i,1) - snow(i) = tem * qsnw(i,1) - graupel(i) = tem * qgl(i,1) + new_qi = gq0_ice(i,1) + dtp*ten_qi(i,1) + ice(i) = tem * new_qi + new_qs = gq0_snow(i,1) + dtp*ten_qs(i,1) + snow(i) = tem * new_qs + new_qg = gq0_graupel(i,1) + dtp*ten_qg(i,1) + graupel(i) = tem * new_qg enddo endif -! if (lprnt) write(0,*)' cloudsm=',tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt -! if (lprnt) write(0,*)' clw2aft=',stateout%gq0(ipr,:,ntcw),' kdt=',kdt -! if (lprnt) write(0,*)' qrna=',qrn(ipr,:),' kdt=',kdt -! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt -! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt -! - - end subroutine m_micro_post_run end module m_micro_post diff --git a/physics/MP/Morrison_Gettelman/m_micro_post.meta b/physics/MP/Morrison_Gettelman/m_micro_post.meta index 88a4325e7..83bd2034d 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_post.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_post.meta @@ -36,56 +36,8 @@ dimensions = () type = logical intent = in -[ncpr] - standard_name = local_rain_number_concentration - long_name = number concentration of rain local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ncps] - standard_name = local_snow_number_concentration - long_name = number concentration of snow local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ncgl] - standard_name = local_graupel_number_concentration - long_name = number concentration of graupel local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qrn] - standard_name = local_rain_water_mixing_ratio - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qsnw] - standard_name = local_snow_water_mixing_ratio - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgl] - standard_name = local_graupel_mixing_ratio - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [gq0_ice] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -93,53 +45,61 @@ kind = kind_phys intent = in [gq0_rain] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = in [gq0_snow] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = in [gq0_graupel] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out -[gq0_rain_nc] - standard_name = mass_number_concentration_of_rain_of_new_state - long_name = number concentration of rain updated by physics - units = kg-1 + intent = in +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out -[gq0_snow_nc] - standard_name = mass_number_concentration_of_snow_of_new_state - long_name = number concentration of snow updated by physics - units = kg-1 + intent = in +[ten_qr] + standard_name = tendency_of_rain_mixing_ratio + long_name = tendency of ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out -[gq0_graupel_nc] - standard_name = mass_number_concentration_of_graupel_of_new_state - long_name = number concentration of graupel updated by physics - units = kg-1 + intent = inout +[ten_qs] + standard_name = tendency_of_snow_mixing_ratio + long_name = tendency of ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout +[ten_qg] + standard_name = tendency_of_graupel_mixing_ratio + long_name = tendency of ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [ice] standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep long_name = ice fall at this time step diff --git a/physics/MP/Morrison_Gettelman/m_micro_pre.F90 b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 index 8bd75acad..9c2b7faff 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_pre.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 @@ -10,28 +10,18 @@ module m_micro_pre !! \section arg_table_m_micro_pre_run Argument Table !! \htmlinclude m_micro_pre_run.html !! - subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & - gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & - qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, clw_water, clw_ice, clcn, errmsg, errflg ) + subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, cld_shoc, & + cld_frc_MG, clcn, errmsg, errflg ) use machine, only : kind_phys implicit none - integer, intent(in) :: im, levs, fprcp - logical, intent(in) :: do_shoc, mg3_as_mg2 + integer, intent(in) :: im, levs + logical, intent(in) :: do_shoc logical, intent(inout) :: skip_macro - real(kind=kind_phys), intent(in) :: tcr, tcrf - real(kind=kind_phys), intent(in) :: & - gq0_ice(:,:), gq0_water(:,:), gq0_rain(:,:), gq0_snow(:,:), & - gq0_graupel(:,:), gq0_rain_nc(:,:), gq0_snow_nc(:,:), & - gq0_graupel_nc(:,:), cnvc(:,:), cnvw(:,:), gt0(:,:) real(kind=kind_phys), intent(in), optional :: cld_shoc(:,:) - real(kind=kind_phys), intent(inout) :: & - qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & - cld_frc_MG(:,:) - - real(kind=kind_phys), intent(out) :: clw_ice(:,:), clw_water(:,:) + real(kind=kind_phys), intent(inout) :: cld_frc_MG(:,:) real(kind=kind_phys), intent(in) :: clcn(:,:) @@ -39,87 +29,18 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq integer, intent(out) :: errflg integer :: i, k - real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - ! Acheng used clw here for other code to run smoothly and minimum change - ! to make the code work. However, the nc and clw should be treated - ! in other procceses too. August 28/2015; Hope that can be done next - ! year. I believe this will make the physical interaction more reasonable - ! Anning 12/5/2015 changed ntcw hold liquid only skip_macro = do_shoc if (do_shoc) then - if (fprcp == 0) then - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - cld_frc_MG(i,k) = cld_shoc(i,k) - enddo - enddo - else if ((abs(fprcp) == 1) .or. mg3_as_mg2) then - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - cld_frc_MG(i,k) = cld_shoc(i,k) - enddo - enddo - else - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) - cld_frc_MG(i,k) = cld_shoc(i,k) - enddo - enddo - end if - else - if (fprcp == 0 ) then - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - enddo - enddo - elseif (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - enddo - enddo - else - do k=1,levs - do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) - enddo + do k=1,levs + do i=1,im + cld_frc_MG(i,k) = cld_shoc(i,k) enddo - endif + enddo end if ! add convective cloud fraction diff --git a/physics/MP/Morrison_Gettelman/m_micro_pre.meta b/physics/MP/Morrison_Gettelman/m_micro_pre.meta index 296c64663..39168434c 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_pre.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.meta @@ -35,84 +35,6 @@ dimensions = () type = logical intent = inout -[fprcp] - standard_name = number_of_frozen_precipitation_species - long_name = number of frozen precipitation species - units = count - dimensions = () - type = integer - intent = in -[mg3_as_mg2] - standard_name = flag_mg3_as_mg2 - long_name = flag for controlling prep for Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in -[gq0_ice] - standard_name = cloud_ice_mixing_ratio_of_new_state - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_water] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_rain] - standard_name = rain_mixing_ratio_of_new_state - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_snow] - standard_name = snow_mixing_ratio_of_new_state - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_graupel] - standard_name = graupel_mixing_ratio_of_new_state - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_rain_nc] - standard_name = mass_number_concentration_of_rain_of_new_state - long_name = number concentration of rain updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_snow_nc] - standard_name = mass_number_concentration_of_snow_of_new_state - long_name = number concentration of snow updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[gq0_graupel_nc] - standard_name = mass_number_concentration_of_graupel_of_new_state - long_name = number concentration of graupel updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [cld_shoc] standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme @@ -122,94 +44,6 @@ kind = kind_phys intent = in optional = True -[cnvc] - standard_name = convective_cloud_cover - long_name = convective cloud cover - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cnvw] - standard_name = convective_cloud_water_mixing_ratio - long_name = moist convective cloud water mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[tcr] - standard_name = cloud_phase_transition_threshold_temperature - long_name = threshold temperature below which cloud starts to freeze - units = K - dimensions = () - type = real - kind = kind_phys - intent = in -[tcrf] - standard_name = reciprocal_of_cloud_phase_transition_temperature_range - long_name = denominator in cloud phase transition = 1/(tcr-tf) - units = K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qrn] - standard_name = local_rain_water_mixing_ratio - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qsnw] - standard_name = local_snow_water_mixing_ratio - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgl] - standard_name = local_graupel_mixing_ratio - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ncpr] - standard_name = local_rain_number_concentration - long_name = number concentration of rain local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ncps] - standard_name = local_snow_number_concentration - long_name = number concentration of snow local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ncgl] - standard_name = local_graupel_number_concentration - long_name = number concentration of graupel local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [cld_frc_MG] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -218,22 +52,6 @@ type = real kind = kind_phys intent = inout -[clw_water] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[clw_ice] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index 74e6c780f..70b87d9ea 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -216,8 +216,10 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & imp_physics, convert_dry_rho, & imp_physics_nssl, nssl_ccn_on, & nssl_hail_on, nssl_invertccn, nssl_3moment, & - ntccn, ntccna, & - errflg, errmsg) + ntccn, ntccna, ten_t, ten_qv, ten_qc, ten_qr, ten_qi, & + ten_qs, ten_qh, ten_qhl, ten_cccn, ten_ccw, ten_crw, & + ten_cci, ten_csw, ten_chw, ten_chl, ten_vh, ten_vhl, & + ten_zrw, ten_zhw, ten_zhl, errflg, errmsg) use module_mp_nssl_2mom, only: calcnfromq, na @@ -228,28 +230,28 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & integer, intent(in) :: mpirank ! Hydrometeors logical, intent(in ) :: convert_dry_rho - real(kind_phys), intent(inout) :: spechum(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout), optional :: cccn(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout), optional :: cccna(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel - real(kind_phys), intent(inout), optional :: qhl(:,:) !(1:ncol,1:nlev) hail - real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number - real(kind_phys), intent(inout), optional :: chl(:,:) !(1:ncol,1:nlev) hail number - real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume - real(kind_phys), intent(inout), optional :: vhl(:,:) !(1:ncol,1:nlev) hail volume - real(kind_phys), intent(inout), optional :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity - real(kind_phys), intent(inout), optional :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity - real(kind_phys), intent(inout), optional :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity + real(kind_phys), intent(in ) :: spechum(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ), optional :: cccn(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ), optional :: cccna(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: qc (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: qr (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: qi (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: qs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: qh (:,:) !(1:ncol,1:nlev) graupel + real(kind_phys), intent(in ), optional :: qhl(:,:) !(1:ncol,1:nlev) hail + real(kind_phys), intent(in ) :: ccw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: crw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: cci(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: csw(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: chw(:,:) !(1:ncol,1:nlev) graupel number + real(kind_phys), intent(in ), optional :: chl(:,:) !(1:ncol,1:nlev) hail number + real(kind_phys), intent(in ) :: vh (:,:) !(1:ncol,1:nlev) graupel volume + real(kind_phys), intent(in ), optional :: vhl(:,:) !(1:ncol,1:nlev) hail volume + real(kind_phys), intent(in ), optional :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity + real(kind_phys), intent(in ), optional :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity + real(kind_phys), intent(in ), optional :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity ! State variables and timestep information - real(kind_phys), intent(inout) :: tgrs (:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(in ) :: tgrs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prslk(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: phii (:,:) !(1:ncol,1:nlev+1) @@ -276,13 +278,35 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & integer, intent(in) :: imp_physics_nssl logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment integer, intent(in) :: ntccn, ntccna - + + real(kind_phys), intent( out) :: ten_t(:,:) + real(kind_phys), intent( out) :: ten_qv(:,:) + real(kind_phys), intent( out) :: ten_qc(:,:) + real(kind_phys), intent( out) :: ten_qr(:,:) + real(kind_phys), intent( out) :: ten_qi(:,:) + real(kind_phys), intent( out) :: ten_qs(:,:) + real(kind_phys), intent( out) :: ten_qh(:,:) + real(kind_phys), intent( out), optional :: ten_qhl(:,:) + real(kind_phys), intent( out) :: ten_cccn(:,:) + real(kind_phys), intent( out) :: ten_ccw(:,:) + real(kind_phys), intent( out) :: ten_crw(:,:) + real(kind_phys), intent( out) :: ten_cci(:,:) + real(kind_phys), intent( out) :: ten_csw(:,:) + real(kind_phys), intent( out) :: ten_chw(:,:) + real(kind_phys), intent( out), optional :: ten_chl(:,:) + real(kind_phys), intent( out) :: ten_vh(:,:) + real(kind_phys), intent( out) :: ten_vhl(:,:) + real(kind_phys), intent( out), optional :: ten_zrw(:,:) + real(kind_phys), intent( out), optional :: ten_zhw(:,:) + real(kind_phys), intent( out), optional :: ten_zhl(:,:) + integer, intent(out) :: errflg character(len=*), intent(out) :: errmsg ! Local variables + real(kind_phys) :: new_t(1:ncol,1:nlev) ! Air density real(kind_phys) :: rho(1:ncol,1:nlev) !< kg m-3 ! Hydrometeors @@ -359,11 +383,36 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys) :: cwmas real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array - - errflg = 0 errmsg = '' + + ten_t = 0.0 + ten_qv = 0.0 + ten_qc = 0.0 + ten_qr = 0.0 + ten_qi = 0.0 + ten_qs = 0.0 + ten_qh = 0.0 + if (nssl_hail_on) then + ten_qhl = 0.0 + ten_chl = 0.0 + ten_vhl = 0.0 + end if + if (nssl_ccn_on) ten_cccn = 0.0 + ten_ccw = 0.0 + ten_crw = 0.0 + ten_cci = 0.0 + ten_csw = 0.0 + ten_chw = 0.0 + ten_vh = 0.0 + if ( nssl_3moment ) then + ten_zrw = 0.0 + ten_zhw = 0.0 + ten_zhl = 0.0 + end if + + new_t = tgrs ! write(0,*) 'nssl_run: nlev,ncol,rank = ',nlev,ncol,mpirank @@ -645,7 +694,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & CALL nssl_2mom_driver( & ITIMESTEP=itimestep, & ! TH=th, & - tt=tgrs, & + tt=new_t, & QV=qv_mp, & QC=qc_mp, & QR=qr_mp, & @@ -699,7 +748,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & CALL nssl_2mom_driver( & ITIMESTEP=itimestep, & ! TH=th, & - tt=tgrs, & + tt=new_t, & QV=qv_mp, & QC=qc_mp, & QR=qr_mp, & @@ -796,71 +845,72 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & IF ( nssl_ccn_on ) THEN write(*,*) 'qc, ccn, ccw, tt, qi+qs by height' DO k = 1,nlev - write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, ccw(1,k)*rho(1,k)*1.e-6, tgrs(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6 + write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, ccw(1,k)*rho(1,k)*1.e-6, new_t(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6 ENDDO ELSE write(*,*) 'qc, ccn, ccw, tt, qi+qs by height' DO k = 1,nlev - write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, 0.0, tgrs(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6 + write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, 0.0, new_t(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6 ENDDO ENDIF ENDIF ENDIF - + + ten_t = (new_t - tgrs)/dtp !> - Convert dry mixing ratios to specific humidity/moist mixing ratios - spechum = qv_mp/(1.0_kind_phys+qv_mp) + ten_qv = (qv_mp/(1.0_kind_phys+qv_mp) - spechum)/dtp IF ( convert_dry_rho ) THEN - qc = qc_mp/(1.0_kind_phys+qv_mp) - qr = qr_mp/(1.0_kind_phys+qv_mp) - qi = qi_mp/(1.0_kind_phys+qv_mp) - qs = qs_mp/(1.0_kind_phys+qv_mp) - qh = qh_mp/(1.0_kind_phys+qv_mp) - IF ( nssl_ccn_on ) cccn = cccn_mp/(1.0_kind_phys+qv_mp) + ten_qc = (qc_mp/(1.0_kind_phys+qv_mp) - qc)/dtp + ten_qr = (qr_mp/(1.0_kind_phys+qv_mp) - qr)/dtp + ten_qi = (qi_mp/(1.0_kind_phys+qv_mp) - qi)/dtp + ten_qs = (qs_mp/(1.0_kind_phys+qv_mp) - qs)/dtp + ten_qh = (qh_mp/(1.0_kind_phys+qv_mp) - qh)/dtp + IF ( nssl_ccn_on ) ten_cccn = (cccn_mp/(1.0_kind_phys+qv_mp) - cccn)/dtp ! cccna = cccna_mp/(1.0_kind_phys+qv_mp) - ccw = nc_mp/(1.0_kind_phys+qv_mp) - crw = nr_mp/(1.0_kind_phys+qv_mp) - cci = ni_mp/(1.0_kind_phys+qv_mp) - csw = ns_mp/(1.0_kind_phys+qv_mp) - chw = nh_mp/(1.0_kind_phys+qv_mp) - vh = vh_mp/(1.0_kind_phys+qv_mp) + ten_ccw = (nc_mp/(1.0_kind_phys+qv_mp) - ccw)/dtp + ten_crw = (nr_mp/(1.0_kind_phys+qv_mp) - crw)/dtp + ten_cci = (ni_mp/(1.0_kind_phys+qv_mp) - cci)/dtp + ten_csw = (ns_mp/(1.0_kind_phys+qv_mp) - csw)/dtp + ten_chw = (nh_mp/(1.0_kind_phys+qv_mp) - chw)/dtp + ten_vh = (vh_mp/(1.0_kind_phys+qv_mp) - vh)/dtp IF ( nssl_3moment ) THEN - zrw = zrw_mp/(1.0_kind_phys+qv_mp) - zhw = zhw_mp/(1.0_kind_phys+qv_mp) + ten_zrw = (zrw_mp/(1.0_kind_phys+qv_mp) - zrw)/dtp + ten_zhw = (zhw_mp/(1.0_kind_phys+qv_mp) - zhw)/dtp ENDIF IF ( nssl_hail_on ) THEN - qhl = qhl_mp/(1.0_kind_phys+qv_mp) - chl = nhl_mp/(1.0_kind_phys+qv_mp) - vhl = vhl_mp/(1.0_kind_phys+qv_mp) + ten_qhl = (qhl_mp/(1.0_kind_phys+qv_mp) - qhl)/dtp + ten_chl = (nhl_mp/(1.0_kind_phys+qv_mp) - chl)/dtp + ten_vhl = (vhl_mp/(1.0_kind_phys+qv_mp) - vhl)/dtp IF ( nssl_3moment ) THEN - zhl = zhl_mp/(1.0_kind_phys+qv_mp) + ten_zhl = (zhl_mp/(1.0_kind_phys+qv_mp) - zhl)/dtp ENDIF ENDIF ELSE ! spechum = qv_mp ! /(1.0_kind_phys+qv_mp) - qc = qc_mp ! /(1.0_kind_phys+qv_mp) - qr = qr_mp ! /(1.0_kind_phys+qv_mp) - qi = qi_mp ! /(1.0_kind_phys+qv_mp) - qs = qs_mp ! /(1.0_kind_phys+qv_mp) - qh = qh_mp ! /(1.0_kind_phys+qv_mp) - IF ( nssl_ccn_on ) cccn = cccn_mp + ten_qc = (qc_mp - qc)/dtp ! /(1.0_kind_phys+qv_mp) + ten_qr = (qr_mp - qr)/dtp! /(1.0_kind_phys+qv_mp) + ten_qi = (qi_mp - qi)/dtp! /(1.0_kind_phys+qv_mp) + ten_qs = (qs_mp - qs)/dtp ! /(1.0_kind_phys+qv_mp) + ten_qh = (qh_mp - qh)/dtp ! /(1.0_kind_phys+qv_mp) + IF ( nssl_ccn_on ) ten_cccn = (cccn_mp - cccn)/dtp ! cccna = cccna_mp - ccw = nc_mp - crw = nr_mp - cci = ni_mp - csw = ns_mp - chw = nh_mp - vh = vh_mp + ten_ccw = (nc_mp - ccw)/dtp + ten_crw = (nr_mp - crw)/dtp + ten_cci = (ni_mp - cci)/dtp + ten_csw = (ns_mp - csw)/dtp + ten_chw = (nh_mp - chw)/dtp + ten_vh = (vh_mp - vh)/dtp IF ( nssl_3moment ) THEN - zrw = zrw_mp - zhw = zhw_mp + ten_zrw = (zrw_mp - zrw)/dtp + ten_zhw = (zhw_mp - zhw)/dtp ENDIF IF ( nssl_hail_on ) THEN - qhl = qhl_mp ! /(1.0_kind_phys+qv_mp) - chl = nhl_mp - vhl = vhl_mp + ten_qhl = (qhl_mp - qhl)/dtp ! /(1.0_kind_phys+qv_mp) + ten_chl = (nhl_mp - chl)/dtp + ten_vhl = (vhl_mp - vhl)/dtp IF ( nssl_3moment ) THEN - zhl = zhl_mp + ten_zhl = (zhl_mp - zhl)/dtp ENDIF ENDIF diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 93a5aa65b..620047377 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -87,7 +87,7 @@ type = MPI_Comm intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension ,vertical_layer_dimension) @@ -95,7 +95,7 @@ kind = kind_phys intent = inout [qr] - standard_name = rain_mixing_ratio + standard_name = physics_timestep_initial_rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -103,7 +103,7 @@ kind = kind_phys intent = inout [qi] - standard_name = cloud_ice_mixing_ratio + standard_name = physics_timestep_initial_cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -111,7 +111,7 @@ kind = kind_phys intent = inout [qs] - standard_name = snow_mixing_ratio + standard_name = physics_timestep_initial_snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -119,7 +119,7 @@ kind = kind_phys intent = inout [qh] - standard_name = graupel_mixing_ratio + standard_name = physics_timestep_initial_graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -127,7 +127,7 @@ kind = kind_phys intent = inout [ccw] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -135,7 +135,7 @@ kind = kind_phys intent = inout [crw] - standard_name = mass_number_concentration_of_rain_water_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_rain_water_in_air long_name = rain number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -143,7 +143,7 @@ kind = kind_phys intent = inout [cci] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -151,7 +151,7 @@ kind = kind_phys intent = inout [csw] - standard_name = mass_number_concentration_of_snow_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_snow_in_air long_name = snow number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -159,7 +159,7 @@ kind = kind_phys intent = inout [chw] - standard_name = mass_number_concentration_of_graupel_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_graupel_in_air long_name = graupel number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -167,7 +167,7 @@ kind = kind_phys intent = inout [vh] - standard_name = graupel_volume + standard_name = physics_timestep_initial_graupel_volume long_name = graupel particle volume units = m3 kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -370,64 +370,64 @@ type = integer intent = in [spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qr] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qi] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qs] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qh] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qhl] - standard_name = hail_mixing_ratio_of_new_state + standard_name = hail_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of hail updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [cccn] - standard_name = cloud_condensation_nuclei_number_concentration_of_new_state + standard_name = cloud_condensation_nuclei_number_concentration long_name = number concentration of cloud condensation nuclei updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -436,115 +436,115 @@ intent = inout optional = True [cccna] - standard_name = activated_cloud_condensation_nuclei_number_concentration_of_new_state + standard_name = activated_cloud_condensation_nuclei_number_concentration long_name = number concentration of activated cloud condensation nuclei updated by physics units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [ccw] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [crw] - standard_name = mass_number_concentration_of_rain_of_new_state + standard_name = mass_number_concentration_of_rain long_name = rain number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [cci] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [csw] - standard_name = mass_number_concentration_of_snow_of_new_state + standard_name = mass_number_concentration_of_snow long_name = snow number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [chw] - standard_name = mass_number_concentration_of_graupel_of_new_state + standard_name = mass_number_concentration_of_graupel long_name = graupel number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [chl] - standard_name = mass_number_concentration_of_hail_of_new_state + standard_name = mass_number_concentration_of_hail long_name = hail number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [vh] - standard_name = graupel_volume_of_new_state + standard_name = graupel_volume long_name = graupel particle volume units = m3 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [vhl] - standard_name = hail_volume_of_new_state + standard_name = hail_volume long_name = hail particle volume units = m3 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [zrw] - standard_name = reflectivity_of_rain_of_new_state + standard_name = reflectivity_of_rain long_name = rain reflectivity units = m6 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [zhw] - standard_name = reflectivity_of_graupel_of_new_state + standard_name = reflectivity_of_graupel long_name = graupel reflectivity units = m6 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [zhl] - standard_name = reflectivity_of_hail_of_new_state + standard_name = reflectivity_of_hail long_name = hail reflectivity units = m6 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [tgrs] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prslk] standard_name = dimensionless_exner_function long_name = dimensionless Exner function at model layer centers @@ -789,6 +789,173 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qv] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qc] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qs] + standard_name = tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qh] + standard_name = tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_qhl] + standard_name = tendency_of_hail_mixing_ratio + long_name = ratio of mass of hail tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_cccn] + standard_name = tendency_of_cloud_condensation_nuclei_number_concentration + long_name = number concentration of cloud condensation nuclei tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_ccw] + standard_name = tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_crw] + standard_name = tendency_of_mass_number_concentration_of_rain_water_in_air + long_name = number concentration of rain tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_cci] + standard_name = tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_csw] + standard_name = tendency_of_mass_number_concentration_of_snow + long_name = number concentration of snow tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_chw] + standard_name = tendency_of_mass_number_concentration_of_graupel + long_name = number concentration of graupel tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_chl] + standard_name = tendency_of_mass_number_concentration_of_hail + long_name = number concentration of hail tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_vh] + standard_name = tendency_of_graupel_volume + long_name = graupel volume tendency + units = m3 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_vhl] + standard_name = tendency_of_hail_volume + long_name = hail volume tendency + units = m3 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_zrw] + standard_name = tendency_of_reflectivity_of_rain + long_name = reflectivity of rain tendency + units = m6 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_zhw] + standard_name = tendency_of_reflectivity_of_graupel + long_name = reflectivity of graupel tendency + units = m6 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[ten_zhl] + standard_name = tendency_of_reflectivity_of_hail + long_name = reflectivity of hail tendency + units = m6 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True [errflg] standard_name = ccpp_error_code long_name = error code for error handling in CCPP diff --git a/physics/MP/TEMPO/mp_tempo.F90 b/physics/MP/TEMPO/mp_tempo.F90 index 174eaac2e..5239be692 100644 --- a/physics/MP/TEMPO/mp_tempo.F90 +++ b/physics/MP/TEMPO/mp_tempo.F90 @@ -395,7 +395,10 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & - is_initialized, errmsg, errflg) + is_initialized, ten_q, dspechum, & + dqc, dqr, dqi, dqs, dqg, dni, dnr, & + dnc, dnwfa, dnifa, dchw, dvh, dtgrs, & + ten_u, ten_v, errmsg, errflg) implicit none @@ -409,27 +412,27 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(in ) :: con_eps ! Hydrometeors logical, intent(in ) :: convert_dry_rho - real(kind_phys), intent(inout) :: spechum(:,:) - real(kind_phys), intent(inout) :: qc(:,:) - real(kind_phys), intent(inout) :: qr(:,:) - real(kind_phys), intent(inout) :: qi(:,:) - real(kind_phys), intent(inout) :: qs(:,:) - real(kind_phys), intent(inout) :: qg(:,:) - real(kind_phys), intent(inout) :: ni(:,:) - real(kind_phys), intent(inout) :: nr(:,:) - real(kind_phys), optional, intent(inout) :: chw(:,:), vh(:,:) + real(kind_phys), intent(in ) :: spechum(:,:) + real(kind_phys), intent(in ) :: qc(:,:) + real(kind_phys), intent(in ) :: qr(:,:) + real(kind_phys), intent(in ) :: qi(:,:) + real(kind_phys), intent(in ) :: qs(:,:) + real(kind_phys), intent(in ) :: qg(:,:) + real(kind_phys), intent(in ) :: ni(:,:) + real(kind_phys), intent(in ) :: nr(:,:) + real(kind_phys), optional, intent(in ) :: chw(:,:), vh(:,:) ! Aerosols logical, intent(in) :: is_aerosol_aware, fullradar_diag logical, intent(in) :: merra2_aerosol_aware, is_hail_aware - real(kind_phys), optional, intent(inout) :: nc(:,:) - real(kind_phys), optional, intent(inout) :: nwfa(:,:) - real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(in ) :: nc(:,:) + real(kind_phys), optional, intent(in ) :: nwfa(:,:) + real(kind_phys), optional, intent(in ) :: nifa(:,:) real(kind_phys), optional, intent(in ) :: nwfa2d(:) real(kind_phys), optional, intent(in ) :: nifa2d(:) real(kind_phys), intent(in) :: aerfld(:,:,:) logical, optional, intent(in ) :: aero_ind_fdb ! State variables and timestep information - real(kind_phys), intent(inout) :: tgrs(:,:) + real(kind_phys), intent(in ) :: tgrs(:,:) real(kind_phys), intent(in ) :: prsl(:,:) real(kind_phys), intent(in ) :: phii(:,:) real(kind_phys), intent(in ) :: omega(:,:) @@ -460,7 +463,25 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & logical, intent(in) :: ext_diag real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:) logical, intent(in) :: reset_diag3d - + + real(kind_phys), intent( out) :: ten_q(:,:,:) + real(kind_phys), intent( out) :: ten_u(:,:) + real(kind_phys), intent( out) :: ten_v(:,:) + real(kind_phys), intent( out) :: dspechum(:,:) + real(kind_phys), intent( out) :: dqc(:,:) + real(kind_phys), intent( out) :: dqr(:,:) + real(kind_phys), intent( out) :: dqi(:,:) + real(kind_phys), intent( out) :: dqs(:,:) + real(kind_phys), intent( out) :: dqg(:,:) + real(kind_phys), intent( out) :: dni(:,:) + real(kind_phys), intent( out) :: dnr(:,:) + real(kind_phys), optional, intent( out) :: dnc(:,:) + real(kind_phys), optional, intent( out) :: dnwfa(:,:) + real(kind_phys), optional, intent( out) :: dnifa(:,:) + real(kind_phys), optional, intent( out) :: dchw(:,:) + real(kind_phys), optional, intent( out) :: dvh(:,:) + real(kind_phys), intent( out) :: dtgrs(:,:) + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -499,7 +520,19 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & real(kind_phys) :: delta_graupel_mp(1:ncol) ! mm real(kind_phys) :: delta_ice_mp(1:ncol) ! mm real(kind_phys) :: delta_snow_mp(1:ncol) ! mm - + + real(kind_phys) :: new_spechum(1:ncol,1:nlev) + real(kind_phys) :: new_qc(1:ncol,1:nlev) + real(kind_phys) :: new_qr(1:ncol,1:nlev) + real(kind_phys) :: new_qi(1:ncol,1:nlev) + real(kind_phys) :: new_qs(1:ncol,1:nlev) + real(kind_phys) :: new_qg(1:ncol,1:nlev) + real(kind_phys) :: new_ni(1:ncol,1:nlev) + real(kind_phys) :: new_nr(1:ncol,1:nlev) + real(kind_phys), allocatable :: new_nc(:,:), new_nwfa(:,:), new_nifa(:,:) + real(kind_phys), allocatable :: new_chw(:,:), new_vh(:,:) + real(kind_phys) :: new_tgrs(1:ncol,1:nlev) + real(kind_phys) :: pfils(1:ncol,1:nlev,1) real(kind_phys) :: pflls(1:ncol,1:nlev,1) ! Radar reflectivity @@ -561,7 +594,56 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - + + ten_q = 0.0 ! Since this scheme is outputting tracer tendencies individually, + ! we also need to initialize the entire array to 0, so that when + ! tendencies are applied, all tracer tendencies other than those + ! set in this scheme are 0. + ten_u = 0.0 + ten_v = 0.0 + dspechum = 0.0 + dqc = 0.0 + dqr = 0.0 + dqi = 0.0 + dqs = 0.0 + dqg = 0.0 + dni = 0.0 + dnr = 0.0 + dtgrs = 0.0 + + new_spechum = spechum + new_qc = qc + new_qr = qr + new_qi = qi + new_qs = qs + new_qg = qg + new_ni = ni + new_nr = nr + new_tgrs = tgrs + + if (is_aerosol_aware .or. merra2_aerosol_aware) then + dnc = 0.0 + dnwfa = 0.0 + dnifa = 0.0 + + allocate(new_nc(ncol,nlev)) + allocate(new_nwfa(ncol,nlev)) + allocate(new_nifa(ncol,nlev)) + new_nc = nc + new_nwfa = nwfa + new_nifa = nifa + endif + + if (is_hail_aware) then + dchw = 0.0 + dvh = 0.0 + + allocate(new_chw(ncol,nlev)) + allocate(new_vh(ncol,nlev)) + new_chw = chw + new_vh = vh + endif + if (is_hail_aware .and. sedi_semi) then write(errmsg, fmt='((a))') 'Cannot use hail-aware TEMPO with sedi_semi... plese set sedi_semi=.false.' errflg = 1 @@ -625,7 +707,7 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & dtstep = dtp end if if (merra2_aerosol_aware) then - call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + call get_niwfa(aerfld, new_nifa, new_nwfa, ncol, nlev) end if !> - Convert specific humidity to water vapor mixing ratio. @@ -635,31 +717,31 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & ! DH* - do this only if istep == 1? Would be ok if it was ! guaranteed that nothing else in the same subcycle group ! was using these arrays, but it is somewhat dangerous. - qv = spechum/(1.0_kind_phys-spechum) + qv = new_spechum/(1.0_kind_phys-new_spechum) if (convert_dry_rho) then - qc = qc/(1.0_kind_phys-spechum) - qr = qr/(1.0_kind_phys-spechum) - qi = qi/(1.0_kind_phys-spechum) - qs = qs/(1.0_kind_phys-spechum) - qg = qg/(1.0_kind_phys-spechum) - - ni = ni/(1.0_kind_phys-spechum) - nr = nr/(1.0_kind_phys-spechum) + new_qc = new_qc/(1.0_kind_phys-new_spechum) + new_qr = new_qr/(1.0_kind_phys-new_spechum) + new_qi = new_qi/(1.0_kind_phys-new_spechum) + new_qs = new_qs/(1.0_kind_phys-new_spechum) + new_qg = new_qg/(1.0_kind_phys-new_spechum) + + new_ni = new_ni/(1.0_kind_phys-new_spechum) + new_nr = new_nr/(1.0_kind_phys-new_spechum) if (is_hail_aware) then - chw = chw/(1.0_kind_phys-spechum) - vh = vh/(1.0_kind_phys-spechum) + new_chw = new_chw/(1.0_kind_phys-new_spechum) + new_vh = new_vh/(1.0_kind_phys-new_spechum) endif if (is_aerosol_aware .or. merra2_aerosol_aware) then - nc = nc/(1.0_kind_phys-spechum) - nwfa = nwfa/(1.0_kind_phys-spechum) - nifa = nifa/(1.0_kind_phys-spechum) + new_nc = new_nc/(1.0_kind_phys-new_spechum) + new_nwfa = new_nwfa/(1.0_kind_phys-new_spechum) + new_nifa = new_nifa/(1.0_kind_phys-new_spechum) end if end if ! *DH !> - Density of air in kg m-3 - rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + rho = con_eps*prsl/(con_rd*new_tgrs*(qv+con_eps)) !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 w = -omega/(rho*con_g) @@ -798,9 +880,9 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & !> - Call mp_gt_driver() with or without aerosols, with or without effective radii, ... if (is_aerosol_aware) then if (is_hail_aware) then - call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, qb=vh, ni=ni, nr=nr, & - nc=nc, ng=chw, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call tempo_3d_to_1d_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, qb=new_vh, ni=new_ni, nr=new_nr, & + nc=new_nc, ng=new_chw, nwfa=new_nwfa, nifa=new_nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -827,9 +909,9 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & ! write(errmsg,'(*(a))') "TEMPO aerosol-aware UNTESTED -- DO NOT USE" ! errflg = 1 ! return - call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call tempo_3d_to_1d_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + nc=new_nc, nwfa=new_nwfa, nifa=new_nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -873,9 +955,9 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & write(errmsg,'(*(a))') "TEMPO aerosol-aware with MERRA2 UNTESTED -- DO NOT USE" errflg = 1 return - call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - nc=nc, nwfa=nwfa, nifa=nifa, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call tempo_3d_to_1d_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + nc=new_nc, nwfa=new_nwfa, nifa=new_nifa, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -915,8 +997,8 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & ! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & ! qcten3=qcten3, else - call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call tempo_3d_to_1d_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -962,25 +1044,25 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & ! was using these arrays, but it is somewhat dangerous. !> - Convert water vapor mixing ratio back to specific humidity - spechum = qv/(1.0_kind_phys+qv) + new_spechum = qv/(1.0_kind_phys+qv) if (convert_dry_rho) then - qc = qc/(1.0_kind_phys+qv) - qr = qr/(1.0_kind_phys+qv) - qi = qi/(1.0_kind_phys+qv) - qs = qs/(1.0_kind_phys+qv) - qg = qg/(1.0_kind_phys+qv) - - ni = ni/(1.0_kind_phys+qv) - nr = nr/(1.0_kind_phys+qv) + new_qc = new_qc/(1.0_kind_phys+qv) + new_qr = new_qr/(1.0_kind_phys+qv) + new_qi = new_qi/(1.0_kind_phys+qv) + new_qs = new_qs/(1.0_kind_phys+qv) + new_qg = new_qg/(1.0_kind_phys+qv) + + new_ni = new_ni/(1.0_kind_phys+qv) + new_nr = new_nr/(1.0_kind_phys+qv) if (is_hail_aware) then - chw = chw/(1.0_kind_phys+qv) - vh = vh/(1.0_kind_phys+qv) + new_chw = new_chw/(1.0_kind_phys+qv) + new_vh = new_vh/(1.0_kind_phys+qv) endif if (is_aerosol_aware .or. merra2_aerosol_aware) then - nc = nc/(1.0_kind_phys+qv) - nwfa = nwfa/(1.0_kind_phys+qv) - nifa = nifa/(1.0_kind_phys+qv) + new_nc = new_nc/(1.0_kind_phys+qv) + new_nwfa = new_nwfa/(1.0_kind_phys+qv) + new_nifa = new_nifa/(1.0_kind_phys+qv) end if end if ! *DH @@ -1004,7 +1086,26 @@ subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & pfi_lsan(:,:) = pfils(:,:,1) pfl_lsan(:,:) = pflls(:,:,1) end if - + + dspechum = (new_spechum - spechum)/dtp + dqc = (new_qc - qc)/dtp + dqr = (new_qr - qr)/dtp + dqi = (new_qi - qi)/dtp + dqs = (new_qs - qs)/dtp + dqg = (new_qg - qg)/dtp + dni = (new_ni - ni)/dtp + dnr = (new_nr - nr)/dtp + dtgrs = (new_tgrs - tgrs)/dtp + if (is_hail_aware) then + dchw = (new_chw - chw)/dtp + dvh = (new_vh - vh)/dtp + end if + if (is_aerosol_aware .or. merra2_aerosol_aware) then + dnc = (new_nc - nc)/dtp + dnwfa = (new_nwfa - nwfa)/dtp + dnifa = (new_nifa - nifa)/dtp + end if + ! DH* Not really needed because they go out of scope ... ! But having them in here seems to cause problems with Intel? ! It looked like this is also nullifying the pointers passed diff --git a/physics/MP/TEMPO/mp_tempo.meta b/physics/MP/TEMPO/mp_tempo.meta index 0bac3e856..4750d5ef7 100644 --- a/physics/MP/TEMPO/mp_tempo.meta +++ b/physics/MP/TEMPO/mp_tempo.meta @@ -167,7 +167,7 @@ type = logical intent = in [spechum] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -175,7 +175,7 @@ kind = kind_phys intent = inout [qc] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -183,7 +183,7 @@ kind = kind_phys intent = inout [qr] - standard_name = rain_mixing_ratio + standard_name = physics_timestep_initial_rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -191,7 +191,7 @@ kind = kind_phys intent = inout [qi] - standard_name = cloud_ice_mixing_ratio + standard_name = physics_timestep_initial_cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -199,7 +199,7 @@ kind = kind_phys intent = inout [qs] - standard_name = snow_mixing_ratio + standard_name = physics_timestep_initial_snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -207,7 +207,7 @@ kind = kind_phys intent = inout [qg] - standard_name = graupel_mixing_ratio + standard_name = physics_timestep_initial_graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -215,7 +215,7 @@ kind = kind_phys intent = inout [chw] - standard_name = mass_number_concentration_of_graupel_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_graupel_in_air long_name = graupel number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -224,7 +224,7 @@ intent = inout optional = True [vh] - standard_name = graupel_volume + standard_name = physics_timestep_initial_graupel_volume long_name = graupel particle volume units = m3 kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -233,7 +233,7 @@ intent = inout optional = True [ni] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -241,7 +241,7 @@ kind = kind_phys intent = inout [nr] - standard_name = mass_number_concentration_of_rain_water_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_rain_water_in_air long_name = rain number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -270,7 +270,7 @@ type = logical intent = in [nc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -297,7 +297,7 @@ intent = inout optional = True [nwfa] - standard_name = mass_number_concentration_of_hygroscopic_aerosols + standard_name = physics_timestep_initial_mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -306,7 +306,7 @@ intent = inout optional = True [nifa] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + standard_name = physics_timestep_initial_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -315,7 +315,7 @@ intent = inout optional = True [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -471,87 +471,87 @@ type = logical intent = in [spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qr] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qi] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qs] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qg] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [chw] - standard_name = mass_number_concentration_of_graupel_of_new_state + standard_name = mass_number_concentration_of_graupel long_name = graupel number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [vh] - standard_name = graupel_volume_of_new_state + standard_name = graupel_volume long_name = graupel particle volume units = m3 kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [ni] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [nr] - standard_name = mass_number_concentration_of_rain_of_new_state + standard_name = mass_number_concentration_of_rain long_name = rain number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [is_aerosol_aware] standard_name = flag_for_aerosol_physics long_name = flag for aerosol-aware physics @@ -574,31 +574,31 @@ type = logical intent = in [nc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nwfa] - standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state + standard_name = mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nifa] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state + standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer @@ -626,13 +626,13 @@ type = logical intent = in [tgrs] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -937,6 +937,147 @@ dimensions = () type = logical intent = inout +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[dspechum] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqc] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqs] + standard_name = tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqg] + standard_name = tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dni] + standard_name = tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dnr] + standard_name = tendency_of_mass_number_concentration_of_rain_water_in_air + long_name = number concentration of rain tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dnc] + standard_name = tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dnwfa] + standard_name = tendency_of_mass_number_concentration_of_hygroscopic_aerosols + long_name = number concentration of water-friendly aerosols tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dnifa] + standard_name = tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + long_name = number concentration of ice-friendly aerosols tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dchw] + standard_name = tendency_of_mass_number_concentration_of_graupel + long_name = number concentration of graupel tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dvh] + standard_name = tendency_of_graupel_volume + long_name = graupel volume tendency + units = m3 kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dtgrs] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/TEMPO/mp_tempo_post.F90 b/physics/MP/TEMPO/mp_tempo_post.F90 index ea71d7f14..3e0a6db50 100644 --- a/physics/MP/TEMPO/mp_tempo_post.F90 +++ b/physics/MP/TEMPO/mp_tempo_post.F90 @@ -51,7 +51,7 @@ end subroutine mp_tempo_post_init !> \section arg_table_mp_tempo_post_run Argument Table !! \htmlinclude mp_tempo_post_run.html !! - subroutine mp_tempo_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, & + subroutine mp_tempo_post_run(ncol, nlev, dtgrs, tgrs, prslk, dtp, ttendlim, & kdt, errmsg, errflg) implicit none @@ -59,8 +59,8 @@ subroutine mp_tempo_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, ! Interface variables integer, intent(in) :: ncol integer, intent(in) :: nlev - real(kind_phys), dimension(:,:), intent(in) :: tgrs_save - real(kind_phys), dimension(:,:), intent(inout) :: tgrs + real(kind_phys), dimension(:,:), intent(in) :: tgrs + real(kind_phys), dimension(:,:), intent(inout) :: dtgrs real(kind_phys), dimension(:,:), intent(in) :: prslk real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in) :: ttendlim @@ -92,23 +92,23 @@ subroutine mp_tempo_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, if (.not.apply_limiter) return ! mp_tend and ttendlim are expressed in potential temperature - mp_tend = (tgrs - tgrs_save)/prslk + mp_tend = dtgrs/prslk #ifdef DEBUG events = 0 #endif do k=1,nlev do i=1,ncol - mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) ) + mp_tend(i,k) = max( -ttendlim, min( ttendlim, mp_tend(i,k) ) ) #ifdef DEBUG - if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then + if (mp_tend(i,k)*prslk(i,k) .ne. dtgrs(i,k)) then write(0,'(a,3i6,3e16.7)') "mp_tempo_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & - & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + & kdt, i, k, tgrs(i,k), tgrs(i,k) + dtp*dtgrs(i,k), tgrs(i,k) + dtp*mp_tend(i,k)*prslk(i,k) events = events + 1 end if #endif - tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + dtgrs(i,k) = mp_tend(i,k)*prslk(i,k) end do end do diff --git a/physics/MP/TEMPO/mp_tempo_post.meta b/physics/MP/TEMPO/mp_tempo_post.meta index 6661948c7..24abc6ecd 100644 --- a/physics/MP/TEMPO/mp_tempo_post.meta +++ b/physics/MP/TEMPO/mp_tempo_post.meta @@ -49,22 +49,22 @@ dimensions = () type = integer intent = in -[tgrs_save] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K +[dtgrs] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [tgrs] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prslk] standard_name = dimensionless_exner_function long_name = dimensionless Exner function at model layer centers diff --git a/physics/MP/TEMPO/mp_tempo_pre.F90 b/physics/MP/TEMPO/mp_tempo_pre.F90 deleted file mode 100644 index 1e5b7b92d..000000000 --- a/physics/MP/TEMPO/mp_tempo_pre.F90 +++ /dev/null @@ -1,44 +0,0 @@ -!>\file mp_tempo_pre.F90 -!! - -! CCPP license goes here, as well as further documentation -!>\ingroup aatempo -module mp_tempo_pre - - use machine, only : kind_phys - - implicit none - - public :: mp_tempo_pre_run - - private - - contains - -!> \section arg_table_mp_tempo_pre_run Argument Table -!! \htmlinclude mp_tempo_pre_run.html -!! - subroutine mp_tempo_pre_run(ncol, nlev, tgrs, tgrs_save, errmsg, errflg) - - implicit none - - ! Interface variables - integer, intent(in ) :: ncol - integer, intent(in ) :: nlev - real(kind_phys), intent(in ) :: tgrs(:,:) - real(kind_phys), intent( out) :: tgrs_save(:,:) - - ! CCPP error handling - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize the CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Save current air temperature for tendency limiters in mp_tempo_post - tgrs_save = tgrs - - end subroutine mp_tempo_pre_run - -end module mp_tempo_pre diff --git a/physics/MP/TEMPO/mp_tempo_pre.meta b/physics/MP/TEMPO/mp_tempo_pre.meta deleted file mode 100644 index 2c6b44c34..000000000 --- a/physics/MP/TEMPO/mp_tempo_pre.meta +++ /dev/null @@ -1,54 +0,0 @@ -[ccpp-table-properties] - name = mp_tempo_pre - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = mp_tempo_pre_run - type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[nlev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[tgrs] - standard_name = air_temperature_of_new_state - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[tgrs_save] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 666a8a53f..414109328 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -383,7 +383,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & - is_initialized, errmsg, errflg) + is_initialized, ten_q, dspechum, dqc, dqr, & + dqi, dqs, dqg, dni, dnr, dnc, dnwfa, & + dnifa, dtgrs, ten_u, ten_v, errmsg, errflg) implicit none @@ -397,26 +399,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(in ) :: con_eps ! Hydrometeors logical, intent(in ) :: convert_dry_rho - real(kind_phys), intent(inout) :: spechum(:,:) - real(kind_phys), intent(inout) :: qc(:,:) - real(kind_phys), intent(inout) :: qr(:,:) - real(kind_phys), intent(inout) :: qi(:,:) - real(kind_phys), intent(inout) :: qs(:,:) - real(kind_phys), intent(inout) :: qg(:,:) - real(kind_phys), intent(inout) :: ni(:,:) - real(kind_phys), intent(inout) :: nr(:,:) + real(kind_phys), intent(in ) :: spechum(:,:) + real(kind_phys), intent(in ) :: qc(:,:) + real(kind_phys), intent(in ) :: qr(:,:) + real(kind_phys), intent(in ) :: qi(:,:) + real(kind_phys), intent(in ) :: qs(:,:) + real(kind_phys), intent(in ) :: qg(:,:) + real(kind_phys), intent(in ) :: ni(:,:) + real(kind_phys), intent(in ) :: nr(:,:) ! Aerosols logical, intent(in) :: is_aerosol_aware, fullradar_diag logical, intent(in) :: merra2_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(:,:) - real(kind_phys), optional, intent(inout) :: nwfa(:,:) - real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(in ) :: nc(:,:) + real(kind_phys), optional, intent(in ) :: nwfa(:,:) + real(kind_phys), optional, intent(in ) :: nifa(:,:) real(kind_phys), optional, intent(in ) :: nwfa2d(:) real(kind_phys), optional, intent(in ) :: nifa2d(:) real(kind_phys), intent(in) :: aerfld(:,:,:) logical, optional, intent(in ) :: aero_ind_fdb ! State variables and timestep information - real(kind_phys), intent(inout) :: tgrs(:,:) + real(kind_phys), intent(in ) :: tgrs(:,:) real(kind_phys), intent(in ) :: prsl(:,:) real(kind_phys), intent(in ) :: phii(:,:) real(kind_phys), intent(in ) :: omega(:,:) @@ -447,7 +449,23 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & logical, intent(in) :: ext_diag real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:) logical, intent(in) :: reset_diag3d - + + real(kind_phys), intent( out) :: ten_q(:,:,:) + real(kind_phys), intent( out) :: ten_u(:,:) + real(kind_phys), intent( out) :: ten_v(:,:) + real(kind_phys), intent( out) :: dspechum(:,:) + real(kind_phys), intent( out) :: dqc(:,:) + real(kind_phys), intent( out) :: dqr(:,:) + real(kind_phys), intent( out) :: dqi(:,:) + real(kind_phys), intent( out) :: dqs(:,:) + real(kind_phys), intent( out) :: dqg(:,:) + real(kind_phys), intent( out) :: dni(:,:) + real(kind_phys), intent( out) :: dnr(:,:) + real(kind_phys), optional, intent( out) :: dnc(:,:) + real(kind_phys), optional, intent( out) :: dnwfa(:,:) + real(kind_phys), optional, intent( out) :: dnifa(:,:) + real(kind_phys), intent( out) :: dtgrs(:,:) + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -486,7 +504,18 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys) :: delta_graupel_mp(1:ncol) ! mm real(kind_phys) :: delta_ice_mp(1:ncol) ! mm real(kind_phys) :: delta_snow_mp(1:ncol) ! mm - + + real(kind_phys) :: new_spechum(1:ncol,1:nlev) + real(kind_phys) :: new_qc(1:ncol,1:nlev) + real(kind_phys) :: new_qr(1:ncol,1:nlev) + real(kind_phys) :: new_qi(1:ncol,1:nlev) + real(kind_phys) :: new_qs(1:ncol,1:nlev) + real(kind_phys) :: new_qg(1:ncol,1:nlev) + real(kind_phys) :: new_ni(1:ncol,1:nlev) + real(kind_phys) :: new_nr(1:ncol,1:nlev) + real(kind_phys), allocatable :: new_nc(:,:), new_nwfa(:,:), new_nifa(:,:) + real(kind_phys) :: new_tgrs(1:ncol,1:nlev) + real(kind_phys) :: pfils(1:ncol,1:nlev,1) real(kind_phys) :: pflls(1:ncol,1:nlev,1) ! Radar reflectivity @@ -548,7 +577,46 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - + + ten_q = 0.0 ! Since this scheme is outputting tracer tendencies individually, + ! we also need to initialize the entire array to 0, so that when + ! tendencies are applied, all tracer tendencies other than those + ! set in this scheme are 0. + ten_u = 0.0 + ten_v = 0.0 + dspechum = 0.0 + dqc = 0.0 + dqr = 0.0 + dqi = 0.0 + dqs = 0.0 + dqg = 0.0 + dni = 0.0 + dnr = 0.0 + dtgrs = 0.0 + + new_spechum = spechum + new_qc = qc + new_qr = qr + new_qi = qi + new_qs = qs + new_qg = qg + new_ni = ni + new_nr = nr + new_tgrs = tgrs + + if (is_aerosol_aware .or. merra2_aerosol_aware) then + dnc = 0.0 + dnwfa = 0.0 + dnifa = 0.0 + + allocate(new_nc(ncol,nlev)) + allocate(new_nwfa(ncol,nlev)) + allocate(new_nifa(ncol,nlev)) + new_nc = nc + new_nwfa = nwfa + new_nifa = nifa + end if + if (first_time_step .and. istep==1 .and. blkno==1) then ! Check initialization state if (.not.is_initialized) then @@ -606,7 +674,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & dtstep = dtp end if if (merra2_aerosol_aware) then - call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + call get_niwfa(aerfld, new_nifa, new_nwfa, ncol, nlev) end if !> - Convert specific humidity to water vapor mixing ratio. @@ -616,27 +684,27 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! DH* - do this only if istep == 1? Would be ok if it was ! guaranteed that nothing else in the same subcycle group ! was using these arrays, but it is somewhat dangerous. - qv = spechum/(1.0_kind_phys-spechum) + qv = new_spechum/(1.0_kind_phys-new_spechum) if (convert_dry_rho) then - qc = qc/(1.0_kind_phys-spechum) - qr = qr/(1.0_kind_phys-spechum) - qi = qi/(1.0_kind_phys-spechum) - qs = qs/(1.0_kind_phys-spechum) - qg = qg/(1.0_kind_phys-spechum) - - ni = ni/(1.0_kind_phys-spechum) - nr = nr/(1.0_kind_phys-spechum) + new_qc = new_qc/(1.0_kind_phys-new_spechum) + new_qr = new_qr/(1.0_kind_phys-new_spechum) + new_qi = new_qi/(1.0_kind_phys-new_spechum) + new_qs = new_qs/(1.0_kind_phys-new_spechum) + new_qg = new_qg/(1.0_kind_phys-new_spechum) + + new_ni = new_ni/(1.0_kind_phys-new_spechum) + new_nr = new_nr/(1.0_kind_phys-new_spechum) if (is_aerosol_aware .or. merra2_aerosol_aware) then - nc = nc/(1.0_kind_phys-spechum) - nwfa = nwfa/(1.0_kind_phys-spechum) - nifa = nifa/(1.0_kind_phys-spechum) + new_nc = new_nc/(1.0_kind_phys-new_spechum) + new_nwfa = new_nwfa/(1.0_kind_phys-new_spechum) + new_nifa = new_nifa/(1.0_kind_phys-new_spechum) end if end if ! *DH !> - Density of air in kg m-3 - rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + rho = con_eps*prsl/(con_rd*new_tgrs*(qv+con_eps)) !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 w = -omega/(rho*con_g) @@ -736,9 +804,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if set_extended_diagnostic_pointers !> - Call mp_gt_driver() with or without aerosols, with or without effective radii, ... if (is_aerosol_aware) then - call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call mp_gt_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + nc=new_nc, nwfa=new_nwfa, nifa=new_nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -778,9 +846,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3, pfils=pfils, pflls=pflls) else if (merra2_aerosol_aware) then - call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - nc=nc, nwfa=nwfa, nifa=nifa, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call mp_gt_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + nc=new_nc, nwfa=new_nwfa, nifa=new_nifa, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -820,8 +888,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3, pfils=pfils, pflls=pflls) else - call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + call mp_gt_driver(qv=qv, qc=new_qc, qr=new_qr, qi=new_qi, qs=new_qs, qg=new_qg, ni=new_ni, nr=new_nr, & + tt=new_tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -867,21 +935,21 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! was using these arrays, but it is somewhat dangerous. !> - Convert water vapor mixing ratio back to specific humidity - spechum = qv/(1.0_kind_phys+qv) + new_spechum = qv/(1.0_kind_phys+qv) if (convert_dry_rho) then - qc = qc/(1.0_kind_phys+qv) - qr = qr/(1.0_kind_phys+qv) - qi = qi/(1.0_kind_phys+qv) - qs = qs/(1.0_kind_phys+qv) - qg = qg/(1.0_kind_phys+qv) - - ni = ni/(1.0_kind_phys+qv) - nr = nr/(1.0_kind_phys+qv) + new_qc = new_qc/(1.0_kind_phys+qv) + new_qr = new_qr/(1.0_kind_phys+qv) + new_qi = new_qi/(1.0_kind_phys+qv) + new_qs = new_qs/(1.0_kind_phys+qv) + new_qg = new_qg/(1.0_kind_phys+qv) + + new_ni = new_ni/(1.0_kind_phys+qv) + new_nr = new_nr/(1.0_kind_phys+qv) if (is_aerosol_aware .or. merra2_aerosol_aware) then - nc = nc/(1.0_kind_phys+qv) - nwfa = nwfa/(1.0_kind_phys+qv) - nifa = nifa/(1.0_kind_phys+qv) + new_nc = new_nc/(1.0_kind_phys+qv) + new_nwfa = new_nwfa/(1.0_kind_phys+qv) + new_nifa = new_nifa/(1.0_kind_phys+qv) end if end if ! *DH @@ -906,6 +974,21 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & pfl_lsan(:,:) = pflls(:,:,1) end if + dspechum = (new_spechum - spechum)/dtp + dqc = (new_qc - qc)/dtp + dqr = (new_qr - qr)/dtp + dqi = (new_qi - qi)/dtp + dqs = (new_qs - qs)/dtp + dqg = (new_qg - qg)/dtp + dni = (new_ni - ni)/dtp + dnr = (new_nr - nr)/dtp + dtgrs = (new_tgrs - tgrs)/dtp + if (is_aerosol_aware .or. merra2_aerosol_aware) then + dnc = (new_nc - nc)/dtp + dnwfa = (new_nwfa - nwfa)/dtp + dnifa = (new_nifa - nifa)/dtp + end if + end subroutine mp_thompson_run !>@} diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index 09e292672..e8e8efa67 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -227,7 +227,7 @@ type = logical intent = in [spechum] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -235,7 +235,7 @@ kind = kind_phys intent = inout [qc] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -243,7 +243,7 @@ kind = kind_phys intent = inout [qr] - standard_name = rain_mixing_ratio + standard_name = physics_timestep_initial_rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -251,7 +251,7 @@ kind = kind_phys intent = inout [qi] - standard_name = cloud_ice_mixing_ratio + standard_name = physics_timestep_initial_cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -259,7 +259,7 @@ kind = kind_phys intent = inout [qs] - standard_name = snow_mixing_ratio + standard_name = physics_timestep_initial_snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -267,7 +267,7 @@ kind = kind_phys intent = inout [qg] - standard_name = graupel_mixing_ratio + standard_name = physics_timestep_initial_graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -275,7 +275,7 @@ kind = kind_phys intent = inout [ni] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -283,7 +283,7 @@ kind = kind_phys intent = inout [nr] - standard_name = mass_number_concentration_of_rain_water_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_rain_water_in_air long_name = rain number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -305,7 +305,7 @@ type = logical intent = in [nc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + standard_name = physics_timestep_initial_mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -332,7 +332,7 @@ intent = inout optional = True [nwfa] - standard_name = mass_number_concentration_of_hygroscopic_aerosols + standard_name = physics_timestep_initial_mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -341,7 +341,7 @@ intent = inout optional = True [nifa] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + standard_name = physics_timestep_initial_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols units = kg-1 dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -350,7 +350,7 @@ intent = inout optional = True [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_dimension,vertical_layer_dimension) @@ -506,69 +506,69 @@ type = logical intent = in [spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qr] - standard_name = rain_mixing_ratio_of_new_state + standard_name = rain_mixing_ratio long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qi] - standard_name = cloud_ice_mixing_ratio_of_new_state + standard_name = cloud_ice_mixing_ratio long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qs] - standard_name = snow_mixing_ratio_of_new_state + standard_name = snow_mixing_ratio long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qg] - standard_name = graupel_mixing_ratio_of_new_state + standard_name = graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [ni] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = ice number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [nr] - standard_name = mass_number_concentration_of_rain_of_new_state + standard_name = mass_number_concentration_of_rain long_name = rain number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [is_aerosol_aware] standard_name = flag_for_aerosol_physics long_name = flag for aerosol-aware physics @@ -584,31 +584,31 @@ type = logical intent = in [nc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = cloud droplet number concentration units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nwfa] - standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state + standard_name = mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nifa] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state + standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer @@ -636,13 +636,13 @@ type = logical intent = in [tgrs] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -943,6 +943,129 @@ dimensions = () type = logical intent = inout +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out +[dspechum] + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqc] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqr] + standard_name = tendency_of_rain_mixing_ratio + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqi] + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqs] + standard_name = tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dqg] + standard_name = tendency_of_graupel_mixing_ratio + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dni] + standard_name = tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dnr] + standard_name = tendency_of_mass_number_concentration_of_rain_water_in_air + long_name = number concentration of rain tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dnc] + standard_name = tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dnwfa] + standard_name = tendency_of_mass_number_concentration_of_hygroscopic_aerosols + long_name = number concentration of water-friendly aerosols tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dnifa] + standard_name = tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + long_name = number concentration of ice-friendly aerosols tendency + units = kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out + optional = True +[dtgrs] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/Thompson/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 index 7b333f2b1..4dd20aba8 100644 --- a/physics/MP/Thompson/mp_thompson_post.F90 +++ b/physics/MP/Thompson/mp_thompson_post.F90 @@ -56,7 +56,7 @@ end subroutine mp_thompson_post_init !> \section arg_table_mp_thompson_post_run Argument Table !! \htmlinclude mp_thompson_post_run.html !! - subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, & + subroutine mp_thompson_post_run(ncol, nlev, dtgrs, tgrs, prslk, dtp, ttendlim, & kdt, mpicomm, mpirank, mpiroot, errmsg, errflg) implicit none @@ -64,8 +64,8 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli ! Interface variables integer, intent(in) :: ncol integer, intent(in) :: nlev - real(kind_phys), dimension(:,:), intent(in) :: tgrs_save - real(kind_phys), dimension(:,:), intent(inout) :: tgrs + real(kind_phys), dimension(:,:), intent(inout) :: dtgrs + real(kind_phys), dimension(:,:), intent(in) :: tgrs real(kind_phys), dimension(:,:), intent(in) :: prslk real(kind_phys), intent(in) :: dtp real(kind_phys), intent(in) :: ttendlim @@ -100,23 +100,23 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli if (.not.apply_limiter) return ! mp_tend and ttendlim are expressed in potential temperature - mp_tend = (tgrs - tgrs_save)/prslk + mp_tend = dtgrs/prslk #ifdef DEBUG events = 0 #endif do k=1,nlev do i=1,ncol - mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) ) + mp_tend(i,k) = max( -ttendlim, min( ttendlim, mp_tend(i,k) ) ) #ifdef DEBUG - if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then + if (mp_tend(i,k)*prslk(i,k) .ne. dtgrs(i,k)) then write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & - & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + & kdt, i, k, tgrs(i,k), tgrs(i,k) + dtp*dtgrs(i,k), tgrs(i,k) + dtp*mp_tend(i,k)*prslk(i,k) events = events + 1 end if #endif - tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + dtgrs(i,k) = mp_tend(i,k)*prslk(i,k) end do end do diff --git a/physics/MP/Thompson/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta index 85704316f..5c7192dfe 100644 --- a/physics/MP/Thompson/mp_thompson_post.meta +++ b/physics/MP/Thompson/mp_thompson_post.meta @@ -49,22 +49,22 @@ dimensions = () type = integer intent = in -[tgrs_save] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K +[dtgrs] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [tgrs] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = model layer mean temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [prslk] standard_name = dimensionless_exner_function long_name = dimensionless Exner function at model layer centers diff --git a/physics/MP/Thompson/mp_thompson_pre.F90 b/physics/MP/Thompson/mp_thompson_pre.F90 deleted file mode 100644 index 3fe78e4d1..000000000 --- a/physics/MP/Thompson/mp_thompson_pre.F90 +++ /dev/null @@ -1,45 +0,0 @@ -!>\file mp_thompson_pre.F90 -!! - -!>\ingroup aathompson - -!> This module contains the pre-processing of Thompson cloud microphysics -module mp_thompson_pre - - use machine, only : kind_phys - - implicit none - - public :: mp_thompson_pre_run - - private - - contains - -!> \section arg_table_mp_thompson_pre_run Argument Table -!! \htmlinclude mp_thompson_pre_run.html -!! - subroutine mp_thompson_pre_run(ncol, nlev, tgrs, tgrs_save, errmsg, errflg) - - implicit none - - ! Interface variables - integer, intent(in ) :: ncol - integer, intent(in ) :: nlev - real(kind_phys), intent(in ) :: tgrs(:,:) - real(kind_phys), intent( out) :: tgrs_save(:,:) - - ! CCPP error handling - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize the CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Save current air temperature for tendency limiters in mp_thompson_post - tgrs_save = tgrs - - end subroutine mp_thompson_pre_run - -end module mp_thompson_pre diff --git a/physics/MP/Thompson/mp_thompson_pre.meta b/physics/MP/Thompson/mp_thompson_pre.meta deleted file mode 100644 index 563eb2809..000000000 --- a/physics/MP/Thompson/mp_thompson_pre.meta +++ /dev/null @@ -1,54 +0,0 @@ -[ccpp-table-properties] - name = mp_thompson_pre - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = mp_thompson_pre_run - type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[nlev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[tgrs] - standard_name = air_temperature_of_new_state - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[tgrs_save] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/MP/Zhao_Carr/zhaocarr_gscond.meta b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta index ed57ca909..0c1961c5c 100644 --- a/physics/MP/Zhao_Carr/zhaocarr_gscond.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta @@ -94,7 +94,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -118,7 +118,7 @@ kind = kind_phys intent = in [cwm] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = moist cloud condensed water mixing ratio units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -126,7 +126,7 @@ kind = kind_phys intent = out [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = layer mean air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/MP/Zhao_Carr/zhaocarr_precpd.meta b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta index 86e6c7d67..0bc658044 100644 --- a/physics/MP/Zhao_Carr/zhaocarr_precpd.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta @@ -87,7 +87,7 @@ kind = kind_phys intent = in [q] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -95,7 +95,7 @@ kind = kind_phys intent = inout [cwm] - standard_name = cloud_liquid_water_mixing_ratio_of_new_state + standard_name = cloud_liquid_water_mixing_ratio long_name = moist cloud condensed water mixing ratio units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -103,7 +103,7 @@ kind = kind_phys intent = inout [t] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = layer mean air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/PBL/HEDMF/hedmf.f b/physics/PBL/HEDMF/hedmf.f index b75526ba6..166e0f727 100644 --- a/physics/PBL/HEDMF/hedmf.f +++ b/physics/PBL/HEDMF/hedmf.f @@ -66,7 +66,7 @@ end subroutine hedmf_init !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm !! @{ - subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine hedmf_run (im,km,ntrac,ntcw,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & @@ -77,7 +77,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & coef_ric_l,coef_ric_s,ldiag3d,ntqv,rtg_ozone_index,ntoz, & & dtend,dtidx,index_of_process_pbl,index_of_x_wind, & & index_of_y_wind,index_of_temperature, & - & flag_for_pbl_generic_tend,errmsg,errflg) + & flag_for_pbl_generic_tend,ten_t,ten_u,ten_v,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -101,8 +101,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac, var_ric, & & coef_ric_l, coef_ric_s - real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & - & tau(:,:), rtg(:,:,:) + real(kind=kind_phys), intent(inout) :: rtg(:,:,:) ! dtend is only allocated if ldiag3d or qdiag3d are true real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) @@ -134,6 +133,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! logical, intent(in) :: dspheat ! flag for tke dissipative heating + real(kind=kind_phys), intent(out) :: ten_t(:,:), & + & ten_u(:,:), ten_v(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1299,22 +1300,66 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & !> After returning with the solution, the tendencies for temperature and moisture are recovered. do k = 1,km do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt + ten_t(i,k) = (a1(i,k)-t1(i,k)) * rdt qtend = (a2(i,k)-q1(i,k,1))*rdt - tau(i,k) = tau(i,k)+ttend rtg(i,k,1) = rtg(i,k,1)+qtend - dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ten_t(i,k) dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo enddo +! +! compute tke dissipation rate +! +!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature +!! Following Han et al. (2016) \cite Han_2016 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2016) \cite Han_2016 for the PBL and equation 16 for the surface layer. + if(dspheat) then +! + do k = 1,km1 + do i = 1,im + diss(i,k) = dku(i,k)*shr2(i,k)-grav*ti(i,k)*dkt(i,k)*bf(i,k) + ! diss(i,k) = dku(i,k)*shr2(i,k) + enddo + enddo +! +! add dissipative heating at the first model layer +! +!> Next, the temperature tendency is updated following equation 14. + if (hurr_pbl .and. moninq_fac < 0.0) then + ttend_fac = 0.7 + else + ttend_fac = 0.5 + endif + + do i = 1,im + tem = govrth(i)*sflux(i) + tem1 = tem + stress(i)*spd1(i)/zl(i,1) + tem2 = 0.5 * (tem1+diss(i,1)) + tem2 = max(tem2, 0.) + ttend = tem2 / cp + ten_t(i,1) = ten_t(i,1)+ttend_fac*ttend + enddo +! +! add dissipative heating above the first model layer +! + do k = 2,km1 + do i = 1,im + tem = 0.5 * (diss(i,k-1)+diss(i,k)) + tem = max(tem, 0.) + ttend = tem / cp + ten_t(i,k) = ten_t(i,k) + ttend_fac*ttend + enddo + enddo +! + endif + if(.not.flag_for_pbl_generic_tend) then idtend1=dtidx(index_of_temperature,index_of_process_pbl) idtend2=dtidx(ntqv+100,index_of_process_pbl) if(idtend1>=1) then do k = 1,km do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt - dtend(i,k,idtend1) = dtend(i,k,idtend1) + ttend*delt + dtend(i,k,idtend1) = dtend(i,k,idtend1) + & + & ten_t(i,k)*delt enddo enddo endif @@ -1352,51 +1397,6 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & endif endif endif -! -! compute tke dissipation rate -! -!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature -!! Following Han et al. (2016) \cite Han_2016 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2016) \cite Han_2016 for the PBL and equation 16 for the surface layer. - if(dspheat) then -! - do k = 1,km1 - do i = 1,im - diss(i,k) = dku(i,k)*shr2(i,k)-grav*ti(i,k)*dkt(i,k)*bf(i,k) -! diss(i,k) = dku(i,k)*shr2(i,k) - enddo - enddo -! -! add dissipative heating at the first model layer -! -!> Next, the temperature tendency is updated following equation 14. - if (hurr_pbl .and. moninq_fac < 0.0) then - ttend_fac = 0.7 - else - ttend_fac = 0.5 - endif - - do i = 1,im - tem = govrth(i)*sflux(i) - tem1 = tem + stress(i)*spd1(i)/zl(i,1) - tem2 = 0.5 * (tem1+diss(i,1)) - tem2 = max(tem2, 0.) - ttend = tem2 / cp - tau(i,1) = tau(i,1)+ttend_fac*ttend - enddo -! -! add dissipative heating above the first model layer -! - do k = 2,km1 - do i = 1,im - tem = 0.5 * (diss(i,k-1)+diss(i,k)) - tem = max(tem, 0.) - ttend = tem / cp - tau(i,k) = tau(i,k) + ttend_fac*ttend - enddo - enddo -! - endif -! ! compute tridiagonal matrix elements for momentum ! !> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms @@ -1453,12 +1453,10 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & !> Finally, the tendencies are recovered from the tridiagonal solutions. do k = 1,km do i = 1,im - utend = (a1(i,k)-u1(i,k))*rdt - vtend = (a2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k) + utend - dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + conw*del(i,k)*utend - dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend + ten_u(i,k) = (a1(i,k)-u1(i,k))*rdt + ten_v(i,k) = (a2(i,k)-v1(i,k))*rdt + dusfc(i) = dusfc(i) + conw*del(i,k)*ten_u(i,k) + dvsfc(i) = dvsfc(i) + conw*del(i,k)*ten_v(i,k) ! ! for dissipative heating for ecmwf model ! @@ -1476,8 +1474,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & if(idtend1>=1) then do k = 1,km do i = 1,im - utend = (a1(i,k)-u1(i,k))*rdt - dtend(i,k,idtend1) = dtend(i,k,idtend1) + utend*delt + dtend(i,k,idtend1) = dtend(i,k,idtend1) + & + & ten_u(i,k)*delt enddo enddo endif @@ -1486,8 +1484,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & if(idtend2>=1) then do k = 1,km do i = 1,im - vtend = (a2(i,k)-v1(i,k))*rdt - dtend(i,k,idtend2) = dtend(i,k,idtend2) + vtend*delt + dtend(i,k,idtend2) = dtend(i,k,idtend2) + & + & ten_v(i,k)*delt enddo enddo endif diff --git a/physics/PBL/HEDMF/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta index 3d9b492c0..0e9424b5f 100644 --- a/physics/PBL/HEDMF/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -70,30 +70,6 @@ dimensions = () type = integer intent = in -[dv] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[du] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tau] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rtg] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -574,6 +550,30 @@ dimensions = () type = logical intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/MYJ/myjpbl_wrapper.F90 b/physics/PBL/MYJ/myjpbl_wrapper.F90 index cfa4fff09..54573eff6 100644 --- a/physics/PBL/MYJ/myjpbl_wrapper.F90 +++ b/physics/PBL/MYJ/myjpbl_wrapper.F90 @@ -47,14 +47,14 @@ SUBROUTINE myjpbl_wrapper_run( & pblh, kpbl, kinver, slmsk, & garea, ustar, cm, ch, wind, & snowd, zorl, evap, hflx, & - dudt, dvdt, dtdt, dqdt, & + dqdt, & dusfc,dvsfc,dtsfc,dqsfc, & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & con_cp,con_g,con_rd, & me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_pbl, & - ntqv, errmsg, errflg ) + ntqv, ten_t, ten_u, ten_v, errmsg, errflg ) ! @@ -124,16 +124,14 @@ SUBROUTINE myjpbl_wrapper_run( & phii, prsi real(kind=kind_phys),dimension(:,:),intent(in) :: & ugrs, vgrs, tgrs, prsl -! real(kind=kind_phys),dimension(:,:),intent(inout) :: & -! dudt, dvdt, dtdt, dkt - real(kind=kind_phys),dimension(:,:),intent(inout) :: & - dudt, dvdt, dtdt real(kind=kind_phys),dimension(:,:),intent(out) :: & dkt !MYJ-4D real(kind=kind_phys),dimension(:,:,:),intent(inout) :: & qgrs,dqdt + real(kind=kind_phys), intent(out) :: ten_t(:,:), & + ten_u(:,:), ten_v(:,:) !LOCAL integer :: ntsd, k, k1, i, kx1 @@ -589,9 +587,9 @@ SUBROUTINE myjpbl_wrapper_run( & do k=1,levs k1=levs+1-k do i=1,im - dudt(i,k)=dudt(i,k)+rublten(i,k1) - dvdt(i,k)=dvdt(i,k)+rvblten(i,k1) - dtdt(i,k)=dtdt(i,k)+rthblten(i,k1)*exner(i,k1) + ten_t(i,k)=rublten(i,k1) + ten_v(i,k)=rvblten(i,k1) + ten_t(i,k)=rthblten(i,k1)*exner(i,k1) dqdt(i,k,1)=dqdt(i,k,1)+rqvblten(i,k1) dqdt(i,k,ntcw)=dqdt(i,k,ntcw)+rqcblten(i,k1) end do @@ -626,7 +624,7 @@ SUBROUTINE myjpbl_wrapper_run( & k1=levs+1-k do i=1,im ! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs - t_myj1=t_myj(i,k1)+dtdt(i,k)*dt_phs + t_myj1=t_myj(i,k1)+ten_t(i,k)*dt_phs if(tmax.lt.t_myj1)then tmax=t_myj1 i_max=i @@ -648,7 +646,7 @@ SUBROUTINE myjpbl_wrapper_run( & print*,'bad bad tmin,tmax=',tmin,tmax,i_min,k_min,i_max,k_max do k=1,levs - print*,'delt,t_myj=',k,dtdt(i,k)*dt_phs,tgrs(i,k) + print*,'delt,t_myj=',k,ten_t(i,k)*dt_phs,tgrs(i,k) end do print*,'ide,levs,ntsd=',ide,lm,ntsd,dt_myj @@ -689,7 +687,7 @@ SUBROUTINE myjpbl_wrapper_run( & k1=levs+1-k do i=1,im ! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs - t_myj1=t_myj(i,k1)+dtdt(i,k)*dt_phs + t_myj1=t_myj(i,k1)+ten_t(i,k)*dt_phs if(tmax.lt.t_myj1)then tmax=t_myj1 i_max=i @@ -705,7 +703,7 @@ SUBROUTINE myjpbl_wrapper_run( & end do print*,'2after me i_min,k_min,i_max,k_max=',me,i_min,k_min,i_max,k_max print*,'ntsd,tmin,tmax=',ntsd,tmin,tmax - print*,'dtdt(i,j)=',dtdt(i_max,k_max)*dt_phs,t_myj(i_max,k_max) + print*,'ten_t(i,j)*dt=',ten_t(i_max,k_max)*dt_phs,t_myj(i_max,k_max) tmax=-1.e-5 tmin=1.e5 @@ -713,8 +711,8 @@ SUBROUTINE myjpbl_wrapper_run( & k1=levs+1-k do i=1,im ! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs - t_myj1=ugrs(i,k)+dudt(i,k)*dt_phs -! t_myj1=dudt(i,k)*dt_phs + t_myj1=ugrs(i,k)+ten_u(i,k)*dt_phs +! t_myj1=ten_u(i,k)*dt_phs if(tmax.lt.t_myj1)then tmax=t_myj1 i_max=i @@ -729,12 +727,12 @@ SUBROUTINE myjpbl_wrapper_run( & end do print*,'3after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax - print*,'dudt(i,k)=',dudt(i_max,k_max)*dt_phs,ugrs(i_max,k_max) + print*,'ten_u(i,k)*dt=',ten_u(i_max,k_max)*dt_phs,ugrs(i_max,k_max) if(tmax.gt.200.or.tmin.lt.-200)then - print*,'bad,bad,bad=',dudt(i_max,k_max)*dt_phs,ugrs(i_max,k_max) + print*,'bad,bad,bad=',ten_u(i_max,k_max)*dt_phs,ugrs(i_max,k_max) do k=1,levs - print*,'k,dudt*dt_phs,ugrs=',k,dudt(i_max,k)*dt_phs,ugrs(i_max,k) + print*,'k,ten_u*dt_phs,ugrs=',k,ten_u(i_max,k)*dt_phs,ugrs(i_max,k) end do end if @@ -744,8 +742,8 @@ SUBROUTINE myjpbl_wrapper_run( & k1=levs+1-k do i=1,im ! t_myj1=t_myj(i,k1)+rthblten(i,k1)*exner(i,k1)*dt_phs - t_myj1=vgrs(i,k)+dvdt(i,k)*dt_phs -! t_myj1=dvdt(i,k)*dt_phs + t_myj1=vgrs(i,k)+ten_v(i,k)*dt_phs +! t_myj1=ten_v(i,k)*dt_phs if(tmax.lt.t_myj1)then tmax=t_myj1 i_max=i @@ -760,7 +758,7 @@ SUBROUTINE myjpbl_wrapper_run( & end do print*,'4after i_min,k_min,i_max,k_max=',i_min,k_min,i_max,k_max print*,'ntsd,me,tmin,tmax=',ntsd,me,tmin,tmax - print*,'dvdt(i,k)=',dvdt(i_max,k_max)*dt_phs,vgrs(i_max,k_max) + print*,'ten_v(i,k)*dt=',ten_v(i_max,k_max)*dt_phs,vgrs(i_max,k_max) tmax=-1.e-5 tmin=1.e5 diff --git a/physics/PBL/MYJ/myjpbl_wrapper.meta b/physics/PBL/MYJ/myjpbl_wrapper.meta index 9b76ac453..8bccad38c 100644 --- a/physics/PBL/MYJ/myjpbl_wrapper.meta +++ b/physics/PBL/MYJ/myjpbl_wrapper.meta @@ -449,30 +449,6 @@ type = real kind = kind_phys intent = in -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [dqdt] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers PBL vertical diff @@ -664,6 +640,30 @@ dimensions = () type = logical intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 index ff2e9e24f..5ec423176 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 @@ -133,7 +133,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv,& & maxwidth,maxMF,ztop_plume, & & ktop_plume, & - & dudt, dvdt, dtdt, & + & dudt, dvdt, dtdt, dqdt_all, & & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw & dqdt_ozone, & ! <=== ntoz @@ -243,17 +243,15 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-3D real(kind_phys), dimension(:,:), intent(in) :: phii - real(kind_phys), dimension(:,:), intent(inout) :: & - & dtdt, dudt, dvdt, & - & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice, & - & dqdt_snow, dqdt_ice_num_conc, dqdt_ozone - real(kind_phys), dimension(:,:), intent(inout), optional :: & - & dqdt_cloud_droplet_num_conc, dqdt_water_aer_num_conc, & - & dqdt_ice_aer_num_conc + real(kind_phys), dimension(:,:), intent(out) :: & + & dtdt, dudt, dvdt, dqdt_water_vapor, dqdt_liquid_cloud, & + & dqdt_ice, dqdt_snow, dqdt_ozone + real(kind_phys), dimension(:,:,:), intent(out) :: dqdt_all + real(kind_phys), dimension(:,:), intent(out), optional :: & + & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & + & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, dqdt_cccn real(kind_phys), dimension(:,:), intent(inout) :: qke, & & EL_PBL, Sh3D, Sm3D, qc_bl, qi_bl, cldfra_bl - real(kind_phys), dimension(:,:), intent(inout), optional :: & - & dqdt_cccn real(kind_phys), dimension(:,:), intent(inout) :: & & qke_adv real(kind_phys), dimension(:,:,:), intent(out) :: tmf @@ -262,9 +260,9 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv - real(kind_phys), dimension(:,:), intent(inout) :: & - & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice, & - & qgrs_snow + real(kind_phys), dimension(:,:), intent(in) :: & + & t3d,qgrs_water_vapor, qgrs_liquid_cloud, qgrs_ice, & + & qgrs_snow real(kind_phys), dimension(:,:), intent(in) :: & & qgrs_cloud_ice_num_conc, & & u,v,omega, & @@ -290,7 +288,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dz, w, p, rho, th, qv, delp, & & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, & & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, RQSBLTEN, & - & RQNWFABLTEN, RQNIFABLTEN, RQNBCABLTEN + & RQNWFABLTEN, RQNIFABLTEN, RQNBCABLTEN, adj_t real(kind_phys), allocatable :: old_ozone(:,:) !smoke/chem arrays @@ -342,7 +340,34 @@ SUBROUTINE mynnedmf_wrapper_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + dtdt = 0.0 + dudt = 0.0 + dvdt = 0.0 + dqdt_all = 0.0 + dqdt_water_vapor = 0.0 + dqdt_liquid_cloud = 0.0 + dqdt_ice = 0.0 + dqdt_snow = 0.0 + dqdt_ozone = 0.0 + if (imp_physics == imp_physics_thompson) then + if (ltaerosol .or. mraerosol) then + if (ltaerosol) then + dqdt_water_aer_num_conc = 0.0 + dqdt_ice_aer_num_conc = 0.0 + end if + dqdt_cloud_droplet_num_conc = 0.0 + end if + dqdt_ice_num_conc = 0.0 + end if + if (imp_physics == imp_physics_nssl) then + dqdt_cloud_droplet_num_conc = 0.0 + dqdt_ice_num_conc = 0.0 + if (nssl_ccn_on) dqdt_cccn = 0.0 + end if + adj_t = t3d + + if (lprnt) then write(0,*)"==============================================" write(0,*)"in mynn wrapper..." @@ -553,14 +578,6 @@ SUBROUTINE mynnedmf_wrapper_run( & old_ozone = ozone endif - do k=1,levs - do i=1,im - th(i,k)=t3d(i,k)/exner(i,k) - rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)*(1.+p608*max(sqv(i,k),1e-8))) - w(i,k) = -omega(i,k)/(rho(i,k)*grav) - enddo - enddo - do k=1,levs do i=1,im tmf(i,k,1)=0. @@ -587,9 +604,17 @@ SUBROUTINE mynnedmf_wrapper_run( & delp(i,:), exner(i,:), & sqv(i,:), sqc(i,:), & sqi(i,:), kzero(:), & - t3d(i,:) ) + adj_t(i,:) ) enddo - + + do k=1,levs + do i=1,im + th(i,k)=adj_t(i,k)/exner(i,k) + rho(i,k)=prsl(i,k)/(r_d*adj_t(i,k)*(1.+p608*max(sqv(i,k),1e-8))) + w(i,k) = -omega(i,k)/(rho(i,k)*grav) + enddo + enddo + !intialize more variables do i=1,im if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 @@ -688,7 +713,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke print*,"bl_mynn_cloudmix=",bl_mynn_cloudmix," bl_mynn_mixqt=",bl_mynn_mixqt print*,"icloud_bl=",icloud_bl - print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) + print*,"T:",adj_t(1,1),adj_t(1,2),adj_t(1,levs) print*,"TH:",th(1,1),th(1,2),th(1,levs) print*,"rho:",rho(1,1),rho(1,2),rho(1,levs) print*,"exner:",exner(1,1),exner(1,2),exner(1,levs) @@ -726,11 +751,11 @@ SUBROUTINE mynnedmf_wrapper_run( & & u=u,v=v,w=w,th=th,sqv3D=sqv,sqc3D=sqc, & & sqi3D=sqi,sqs3D=sqs,qnc=qnc,qni=qni, & & qnwfa=qnwfa,qnifa=qnifa,qnbca=qnbca,ozone=ozone, & - & p=prsl,exner=exner,rho=rho,T3D=t3d, & + & p=prsl,exner=exner,rho=rho,T3D=adj_t, & & xland=xland,ts=ts,qsfc=qsfc,ps=ps, & & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, & & wspd=wspd,uoce=uoce,voce=voce, & !input - & qke=QKE,qke_adv=qke_adv, & !output + & qke=QKE,qke_adv=qke_adv, & !output !GJF qke_adv needs to be intent(in) & sh3d=Sh3d,sm3d=Sm3d, & !chem/smoke & nchem=nchem,kdvel=kdvel,ndvel=ndvel, & @@ -792,15 +817,15 @@ SUBROUTINE mynnedmf_wrapper_run( & !For MYNN, convert TH-tend to T-tend do k = 1, levs do i = 1, im - dtdt(i,k) = dtdt(i,k) + RTHBLTEN(i,k)*exner(i,k) - dudt(i,k) = dudt(i,k) + RUBLTEN(i,k) - dvdt(i,k) = dvdt(i,k) + RVBLTEN(i,k) + dtdt(i,k) = RTHBLTEN(i,k)*exner(i,k) + dudt(i,k) = RUBLTEN(i,k) + dvdt(i,k) = RVBLTEN(i,k) enddo enddo accum_duvt3dt: if(ldiag3d .or. lsidea) then - call dtend_helper(index_of_x_wind,RUBLTEN) - call dtend_helper(index_of_y_wind,RVBLTEN) - call dtend_helper(index_of_temperature,RTHBLTEN,exner) + call dtend_helper(index_of_x_wind,dudt) + call dtend_helper(index_of_y_wind,dvdt) + call dtend_helper(index_of_temperature,dtdt) if(ldiag3d) then call dtend_helper(100+ntoz,dqdt_ozone) ! idtend = dtidx(100+ntoz,index_of_process_pbl) @@ -813,7 +838,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !Update T, U and V: !do k = 1, levs ! do i = 1, im - ! T3D(i,k) = T3D(i,k) + RTHBLTEN(i,k)*exner(i,k)*delt + ! T3D(i,k) = adj_t(i,k) + RTHBLTEN(i,k)*exner(i,k)*delt ! u(i,k) = u(i,k) + RUBLTEN(i,k)*delt ! v(i,k) = v(i,k) + RVBLTEN(i,k)*delt ! enddo @@ -994,7 +1019,7 @@ SUBROUTINE mynnedmf_wrapper_run( & if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" - print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) + print*,"T:",adj_t(1,1),adj_t(1,2),adj_t(1,levs) print*,"TH:",th(1,1),th(1,2),th(1,levs) print*,"rho:",rho(1,1),rho(1,2),rho(1,levs) print*,"exner:",exner(1,1),exner(1,2),exner(1,levs) diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index e7b8a5a32..cead2949e 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -279,7 +279,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qgrs_water_vapor] standard_name = specific_humidity long_name = water vapor specific humidity @@ -287,7 +287,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qgrs_liquid_cloud] standard_name = cloud_liquid_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) @@ -295,7 +295,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qgrs_ice] standard_name = cloud_ice_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) @@ -303,7 +303,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qgrs_snow] standard_name = snow_mixing_ratio long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) @@ -311,7 +311,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [qgrs_cloud_droplet_num_conc] standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = number concentration of cloud droplets (liquid) @@ -330,8 +330,8 @@ kind = kind_phys intent = in [qgrs_ozone] - standard_name = ozone_mixing_ratio - long_name = ozone mixing ratio + standard_name = ozone_concentration + long_name = ozone concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real @@ -752,7 +752,7 @@ [qke_adv] standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy - units = J + units = J kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -1027,112 +1027,121 @@ type = integer intent = inout [dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out +[dqdt_all] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [dqdt_water_vapor] - standard_name = process_split_cumulative_tendency_of_specific_humidity - long_name = water vapor specific humidity tendency due to model physics + standard_name = tendency_of_specific_humidity + long_name = water vapor specific humidity tendency units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dqdt_liquid_cloud] - standard_name = process_split_cumulative_tendency_of_cloud_liquid_water_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics + standard_name = tendency_of_cloud_liquid_water_mixing_ratio + long_name = cloud condensed water mixing ratio tendency units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dqdt_ice] - standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics + standard_name = tendency_of_cloud_ice_mixing_ratio + long_name = cloud condensed water mixing ratio tendency units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dqdt_snow] - standard_name = process_split_cumulative_tendency_of_snow_mixing_ratio - long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) due to model physics + standard_name = tendency_of_snow_mixing_ratio + long_name = tendency of ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dqdt_ozone] - standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio - long_name = ozone mixing ratio tendency due to model physics + standard_name = tendency_of_ozone_concentration + long_name = ozone concentration tendency units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out [dqdt_cloud_droplet_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number conc. of cloud droplets (liquid) tendency due to model physics + standard_name = tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = number concentration of cloud droplets (liquid) tendency units = kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = True [dqdt_ice_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number conc. of ice tendency due to model physics + standard_name = tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = number concentration of ice tendency units = kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out + optional = True [dqdt_water_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_hygroscopic_aerosols - long_name = number conc. of water-friendly aerosols tendency due to model physics + standard_name = tendency_of_mass_number_concentration_of_hygroscopic_aerosols + long_name = number concentration of water-friendly aerosols tendency units = kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = True [dqdt_ice_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number conc. of ice-friendly aerosols tendency due to model physics + standard_name = tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + long_name = number concentration of ice-friendly aerosols tendency units = kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = True [dqdt_cccn] - standard_name = tendency_of_cloud_condensation_nuclei_number_concentration_due_to_model_physics - long_name = number concentration of cloud condensation nuclei tendency due to model physics + standard_name = tendency_of_cloud_condensation_nuclei_number_concentration + long_name = number concentration of cloud condensation nuclei tendency units = kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = True [tmf] standard_name = tendency_of_vertically_diffused_tracer_concentration diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.F90 new file mode 100644 index 000000000..b5a7f9ebd --- /dev/null +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.F90 @@ -0,0 +1,98 @@ +! ######################################################################################### +!> \file mynnedmf_wrapper_post.f90 +!! +! ######################################################################################### +module mynnedmf_wrapper_post + use machine, only: kind_phys + implicit none +contains + +! ######################################################################################### +!> \section arg_table_mynnedmf_wrapper_post_run Argument Table +!! \htmlinclude mynnedmf_wrapper_post_run.html +!! +! ######################################################################################### + subroutine mynnedmf_wrapper_post_run (tend_opt_pbl, im, levs, ntrac, & + dtp, ten_t, ten_u, ten_v, ten_q, gt0, gu0, gv0, gq0, dtdt, dudt, dvdt, dqdt, & + errmsg, errflg) + + ! Inputs + integer, intent(in) :: tend_opt_pbl, im, levs, ntrac + real(kind=kind_phys), intent(in) :: dtp + real(kind=kind_phys), intent(in), dimension(:,:) :: ten_u, ten_v, ten_t + real(kind=kind_phys), intent(in), dimension(:,:,:) :: ten_q + real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dqdt + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP Error message. + integer, intent(out) :: & + errflg ! CCPP Error flag. + + ! Locals + integer :: i,k,n + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + case_pbl_ten: select case (tend_opt_pbl) + case (1) !immediately apply tendencies + !Current state = current state + dt*current tendency + !Accumulated tendency unchanged + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*ten_t(i,k) + gu0(i,k) = gu0(i,k) + dtp*ten_u(i,k) + gv0(i,k) = gv0(i,k) + dtp*ten_v(i,k) + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*ten_q(i,k,n) + end do + end do + end do + case (2) !add tendencies to sum + !Accumulated tendency = accumulated tendency + current tendency + !Current state unchanged + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + ten_t(i,k) + dudt(i,k) = dudt(i,k) + ten_u(i,k) + dvdt(i,k) = dvdt(i,k) + ten_v(i,k) + do n = 1, ntrac + dqdt(i,k,n) = dqdt(i,k,n) + ten_q(i,k,n) + end do + end do + end do + case (3) !add tendencies to sum and apply + !Current state = current state + dt*(accumulated tendency + current tendency) + !Accumulated tendency = 0 + do k=1,levs + do i=1,im + gt0(i,k) = gt0(i,k) + dtp*(dtdt(i,k) + ten_t(i,k)) + dtdt(i,k) = 0.0 + gu0(i,k) = gu0(i,k) + dtp*(dudt(i,k) + ten_u(i,k)) + dudt(i,k) = 0.0 + gv0(i,k) = gv0(i,k) + dtp*(dvdt(i,k) + ten_v(i,k)) + dvdt(i,k) = 0.0 + do n = 1, ntrac + gq0(i,k,n) = gq0(i,k,n) + dtp*(dqdt(i,k,n) + ten_q(i,k,n)) + dqdt(i,k,n) = 0.0 + end do + end do + end do + case (4) !Current state unchanged + !Accumulated tendency unchanged + !Current tendency unchanged (but will be overwritten during next primary scheme) + exit case_pbl_ten + case default + errflg = 1 + errmsg = 'A tendency application control was outside of the acceptable range (1-4)' + return + end select case_pbl_ten + + end subroutine mynnedmf_wrapper_post_run + +end module mynnedmf_wrapper_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.meta similarity index 51% rename from physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.meta index b84d10691..df867d5bf 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper_post.meta @@ -1,13 +1,20 @@ ######################################################################## [ccpp-table-properties] - name = GFS_suite_stateout_reset + name = mynnedmf_wrapper_post type = scheme - dependencies = ../../hooks/machine.F - + dependencies = ../../hooks/machine.F, + ######################################################################## [ccpp-arg-table] - name = GFS_suite_stateout_reset_run + name = mynnedmf_wrapper_post_run type = scheme +[tend_opt_pbl] + standard_name = control_for_application_method_of_planetary_boundary_layer_tendencies + long_name = control for application method of planetary boundary layer tendencies + units = 1 + dimensions = () + type = integer + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -29,70 +36,110 @@ dimensions = () type = integer intent = in -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = out + intent = inout +[dtdt] + standard_name = process_split_cumulative_tendency_of_air_temperature + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dudt] + standard_name = process_split_cumulative_tendency_of_x_wind + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = process_split_cumulative_tendency_of_y_wind + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[dqdt] + standard_name = process_split_cumulative_tendency_of_tracers + long_name = updated tendency of the tracers due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -107,4 +154,5 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out + \ No newline at end of file diff --git a/physics/PBL/SATMEDMF/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F index 43995f88a..6d10d529d 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdif.F +++ b/physics/PBL/SATMEDMF/satmedmfvdif.F @@ -61,7 +61,7 @@ end subroutine satmedmfvdif_init !! \section detail_satmedmfvidf GFS satmedmfvdif Detailed Algorithm subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & + & rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & @@ -69,7 +69,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & kinver,xkzm_m,xkzm_h,xkzm_s, & & index_of_temperature,index_of_x_wind,index_of_y_wind, & & index_of_process_pbl,ntqv,ntoz,dtend,dtidx, & - & gen_tend,ldiag3d,errmsg,errflg) + & gen_tend,ten_t,ten_u,ten_v,ldiag3d,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -90,8 +90,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & - & tdt(:,:), rtg(:,:,:) + real(kind=kind_phys), intent(inout) :: rtg(:,:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & & t1(:,:), q1(:,:,:), & @@ -110,7 +109,8 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & & hpbl(:) -! + real(kind=kind_phys), intent(out) :: ten_t(:,:), & + & ten_u(:,:), ten_v(:,:) logical, intent(in) :: dspheat character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -203,7 +203,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & ri, rimin, & rbcr, rbint, tdzmin, & rlmn, rlmx, elmx, - & ttend, utend, vtend, qtend, + & qtend, & zfac, zfmin, vk, spdk2, & tkmin, xkzinv, dspfac, xkgdx, & zlup, zldn, bsum, @@ -1401,24 +1401,13 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! do k = 1,km do i = 1,im - ttend = (f1(i,k)-t1(i,k))*rdt + ten_t(i,k) = (f1(i,k)-t1(i,k))*rdt qtend = (f2(i,k)-q1(i,k,1))*rdt - tdt(i,k) = tdt(i,k)+ttend rtg(i,k,1) = rtg(i,k,1)+qtend - dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ten_t(i,k) dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo enddo - if (ldiag3d .and. .not. gen_tend) then - idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-t1) - endif - idtend = dtidx(100+ntqv,index_of_process_pbl) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) - endif - endif ! if(ntrac1 >= 2) then do kk = 2, ntrac1 @@ -1439,11 +1428,21 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & do i = 1,im ! tem = min(diss(i,k), dspmax) ! ttend = tem / cp - ttend = diss(i,k) / cp - tdt(i,k) = tdt(i,k) + dspfac * ttend + ten_t(i,k) = ten_t(i,k) + dspfac * diss(i,k) / cp enddo enddo endif + + if (ldiag3d .and. .not. gen_tend) then + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*ten_t(i,k) + endif + idtend = dtidx(100+ntqv,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) + endif + endif ! !> -# Compute tridiagonal matrix elements for momentum ! @@ -1511,22 +1510,20 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! do k = 1,km do i = 1,im - utend = (f1(i,k)-u1(i,k))*rdt - vtend = (f2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k)+utend - dv(i,k) = dv(i,k)+vtend - dusfc(i) = dusfc(i)+conw*del(i,k)*utend - dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend + ten_u(i,k) = (f1(i,k)-u1(i,k))*rdt + ten_v(i,k) = (f2(i,k)-v1(i,k))*rdt + dusfc(i) = dusfc(i)+conw*del(i,k)*ten_u(i,k) + dvsfc(i) = dvsfc(i)+conw*del(i,k)*ten_v(i,k) enddo enddo if (ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-u1) + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*ten_u(i,k) endif idtend=dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-v1) + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*ten_v(i,k) endif endif ! diff --git a/physics/PBL/SATMEDMF/satmedmfvdif.meta b/physics/PBL/SATMEDMF/satmedmfvdif.meta index 2f0e0514d..daf3c5be4 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdif.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdif.meta @@ -163,30 +163,6 @@ type = real kind = kind_phys intent = in -[dv] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[du] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rtg] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -568,6 +544,30 @@ dimensions = () type = logical intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 73991e27d..511b4cc10 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -90,7 +90,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & ntiw,ntke,grav,pi,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & !The following three variables are for SA-3D-TKE & def_1,def_2,def_3,sa3dtke,dku3d_h,dku3d_e, & - & dv,du,tdt,rtg,u1,v1,t1,q1,usfco,vsfco,use_oceanuv, & + & rtg,u1,v1,t1,q1,usfco,vsfco,use_oceanuv, & & swh,hlw,xmu,garea,zvfun,sigmaf, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & @@ -103,6 +103,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !IVAI & ntqv,dtend,dtidx,index_of_temperature,index_of_x_wind, & & index_of_y_wind,index_of_process_pbl,gen_tend,ldiag3d, & + & ten_t, ten_u, ten_v, & & errmsg,errflg) !IVAI: aux arrays ! & naux2d,naux3d,aux2d,aux3d) @@ -134,8 +135,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & real(kind=kind_phys), optional, intent(in) :: claie(:), cfch(:), & & cfrt(:), cclu(:), cpopu(:) !---------------------------------------------- - real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & - & tdt(:,:), rtg(:,:,:), tkeh(:,:) + real(kind=kind_phys), intent(inout) :: rtg(:,:,:), tkeh(:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & & usfco(:), vsfco(:), & @@ -171,9 +171,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! ! flag for tke dissipative heating logical, intent(in) :: dspheat + real(kind=kind_phys), intent(out) :: ten_t(:,:), & + & ten_u(:,:), ten_v(:,:) ! flag for TTE-EDMF scheme logical, intent(in) :: tte_edmf -! +! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -281,7 +283,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & rdt, rdz, qmin, qlmin, & rimin, rbcr, rbint, tdzmin, & rlmn, rlmn0, rlmn1, rlmn2, - & ttend, utend, vtend, qtend, + & qtend, & zfac, zfmin, vk, spdk2, & tkmin, tkbmx, disste, xkgdx, & xkinv1, xkinv2, @@ -2888,10 +2890,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & c do k = 1,km do i = 1,im - ttend = (f1(i,k)-t1(i,k))*rdt - qtend = (f2(i,k)-q1(i,k,1))*rdt - tdt(i,k) = tdt(i,k)+ttend - rtg(i,k,1) = rtg(i,k,1)+qtend + ten_t(i,k) = (f1(i,k)-t1(i,k))*rdt + qtend = (f2(i,k)-q1(i,k,1))*rdt + rtg(i,k,1) = rtg(i,k,1)+qtend ! dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend ! dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo @@ -2907,8 +2908,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(idtend>=1) then do k = 1,km do i = 1,im - ttend = (f1(i,k)-t1(i,k))*rdt - dtend(i,k,idtend) = dtend(i,k,idtend)+ttend*delt + dtend(i,k,idtend) = dtend(i,k,idtend)+ten_t(i,k)*delt enddo enddo endif @@ -2960,8 +2960,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & do i = 1,im ! tem = min(diss(i,k), dspmax) ! ttend = tem / cp - ttend = diss(i,k) / cp - tdt(i,k) = tdt(i,k) + dspfac * ttend + ten_t(i,k) = ten_t(i,k) + dspfac * diss(i,k) / cp enddo enddo if(ldiag3d .and. .not. gen_tend) then @@ -2969,8 +2968,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(idtend>=1) then do k = 1,km1 do i = 1,im - ttend = diss(i,k) / cp - dtend(i,k,idtend) = dtend(i,k,idtend)+dspfac*ttend*delt + dtend(i,k,idtend) = dtend(i,k,idtend)+ + & (dspfac * diss(i,k) / cp)*delt enddo enddo endif @@ -3043,10 +3042,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & c do k = 1,km do i = 1,im - utend = (f1(i,k)-u1(i,k))*rdt - vtend = (f2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k)+utend - dv(i,k) = dv(i,k)+vtend + ten_u(i,k) = (f1(i,k)-u1(i,k))*rdt + ten_v(i,k) = (f2(i,k)-v1(i,k))*rdt ! dusfc(i) = dusfc(i)+conw*del(i,k)*utend ! dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo @@ -3067,8 +3064,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(idtend>=1) then do k = 1,km do i = 1,im - utend = (f1(i,k)-u1(i,k))*rdt - dtend(i,k,idtend) = dtend(i,k,idtend) + utend*delt + dtend(i,k,idtend) = dtend(i,k,idtend) + ten_u(i,k)*delt enddo enddo endif @@ -3077,8 +3073,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(idtend>=1) then do k = 1,km do i = 1,im - vtend = (f2(i,k)-v1(i,k))*rdt - dtend(i,k,idtend) = dtend(i,k,idtend) + vtend*delt + dtend(i,k,idtend) = dtend(i,k,idtend) + ten_v(i,k)*delt enddo enddo endif diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index 002389307..8d9da52ec 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -177,30 +177,6 @@ type = real kind = kind_phys intent = in -[dv] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[du] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rtg] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -812,6 +788,30 @@ dimensions = () type = logical intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/SHOC/moninshoc.f b/physics/PBL/SHOC/moninshoc.f index 994b78bf6..cca4140a9 100644 --- a/physics/PBL/SHOC/moninshoc.f +++ b/physics/PBL/SHOC/moninshoc.f @@ -41,7 +41,7 @@ end subroutine moninshoc_init !> \section arg_table_moninshoc_run Argument Table !! \htmlinclude moninshoc_run.html !! - subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, + subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,rtg, & u1,v1,t1,q1,tkh,prnum,ntke, & psk,rbsoil,zorl,u10m,v10m,fm,fh, & tsea,heat,evap,stress,spd1,kpbl, @@ -51,7 +51,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & grav,rd,cp,hvap,fv,ntoz,dtend,dtidx, & index_of_temperature,index_of_x_wind, & index_of_y_wind,index_of_process_pbl, - & gen_tend,ldiag3d,ntqv,errmsg,errflg) + & gen_tend,ldiag3d,ntqv,ten_t,ten_u, + & ten_v,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,8 +75,6 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii real(kind=kind_phys), dimension(:,:,:), intent(in) :: q1 - real(kind=kind_phys), dimension(:,:), intent(inout) :: du, dv, - & tau real(kind=kind_phys), dimension(:,:,:), intent(inout) :: rtg real(kind=kind_phys), dimension(:,:,:), intent(inout), optional ::& @@ -91,7 +90,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & dvsfc, dtsfc, dqsfc, hpbl real(kind=kind_phys), dimension(:,:), intent(out) :: prnum real(kind=kind_phys), dimension(:,:), intent(out) :: dkt - + real(kind=kind_phys), dimension(:,:,), intent(out) :: ten_t, + & ten_u, ten_v character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -115,7 +115,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! real(kind=kind_phys) dsdz2, dsdzq, dsdzt, dsig, dt2, rdt &, dtodsd, dtodsu, rdz, tem, tem1 - &, ttend, utend, vtend, qtend + &, qtend &, spdk2, rbint, ri, zol1, robn, bvf2 ! real(kind=kind_phys), parameter :: one=1.0_kp, zero=0.0_kp @@ -463,18 +463,17 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,km do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt + ten_t(i,k) = (a1(i,k)-t1(i,k)) * rdt qtend = (a2(i,k)-q1(i,k,1)) * rdt - tau(i,k) = tau(i,k) + ttend rtg(i,k,1) = rtg(i,k,1) + qtend - dtsfc(i) = dtsfc(i) + del(i,k)*ttend + dtsfc(i) = dtsfc(i) + del(i,k)*ten_t(i,k) dqsfc(i) = dqsfc(i) + del(i,k)*qtend enddo enddo if(ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (a1-t1) + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_t(:,:)*delt endif idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>=1) then @@ -547,23 +546,21 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,km do i = 1,im - utend = (a1(i,k)-u1(i,k))*rdt - vtend = (a2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k) + utend - dv(i,k) = dv(i,k) + vtend + ten_u(i,k) = (a1(i,k)-u1(i,k))*rdt + ten_v(i,k) = (a2(i,k)-v1(i,k))*rdt tem = del(i,k) * gravi - dusfc(i) = dusfc(i) + tem * utend - dvsfc(i) = dvsfc(i) + tem * vtend + dusfc(i) = dusfc(i) + tem * ten_u(i,k) + dvsfc(i) = dvsfc(i) + tem * ten_v(i,k) enddo enddo if (ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + a1-u1 + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_u(:,:)*delt endif idtend = dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + a1-v1 + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_v(:,:)*delt endif endif ! diff --git a/physics/PBL/SHOC/moninshoc.meta b/physics/PBL/SHOC/moninshoc.meta index 37e090943..bfda50d03 100644 --- a/physics/PBL/SHOC/moninshoc.meta +++ b/physics/PBL/SHOC/moninshoc.meta @@ -69,30 +69,6 @@ dimensions = () type = integer intent = in -[dv] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[du] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tau] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [rtg] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -514,6 +490,30 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/SHOC/shoc.F90 b/physics/PBL/SHOC/shoc.F90 index b9860dc33..ca64e190f 100644 --- a/physics/PBL/SHOC/shoc.F90 +++ b/physics/PBL/SHOC/shoc.F90 @@ -39,7 +39,7 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ con_pi, con_fvirt, con_eps, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & - cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) + cld_sgs, tke, tkh, wthv_sec, ten_t, ten_u, ten_v, ten_q, errmsg, errflg) implicit none @@ -52,10 +52,12 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ real(kind=kind_phys), intent(in), dimension(:,:) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(:,:) :: phii ! - real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, tke, tkh, wthv_sec + real(kind=kind_phys), intent(in), dimension(:,:) :: gt0 + real(kind=kind_phys), intent(inout), dimension(:,:) :: tke, tkh, wthv_sec real(kind=kind_phys), intent(inout), dimension(:,:) :: cld_sgs - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 - + real(kind=kind_phys), intent(in), dimension(:,:,:) :: gq0 + real(kind=kind_phys), intent(out), dimension(:,:) :: ten_t, ten_u, ten_v + real(kind=kind_phys), intent(out), dimension(:,:,:) :: ten_q character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -64,6 +66,7 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ integer :: i, k real(kind=kind_phys) :: tem + real(kind=kind_phys), dimension(nx,nzm) :: air_T, qwv real(kind=kind_phys), dimension(nx,nzm) :: qi ! local array of suspended cloud ice real(kind=kind_phys), dimension(nx,nzm) :: qc ! local array of suspended cloud water real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! local array of suspended snowq @@ -76,6 +79,11 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ errmsg = '' errflg = 0 + + ten_t = 0.0 + ten_u = 0.0 + ten_v = 0.0 + ten_q = 0.0 if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm @@ -126,36 +134,49 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ ! phy_f3d(1,1,ntot3d-2) - shoc determined sgs clouds ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - + + air_T = gt0 + qwv = gq0(:,:,ntqv) + call shoc_work (nx, nx, nzm, nzm+1, dtp, prsl, delp, & - phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + phii, phil, u, v, omega, air_T, qwv, qi, qc, qsnw, qrn, & rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & ntlnc, ncpl, ncpi, & con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, & con_fvirt, con_eps) + do k=1,nzm + do i=1,nx + ten_t(i,k) = (air_T(i,k) - gt0(i,k))/dtp if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm do i=1,nx - gq0(i,k,ntcw) = qc(i,k) + qi(i,k) + ten_q(i,k,ntcw) = ((qc(i,k) + qi(i,k)) - (gq0(i,k,ntcw) + gq0(i,k,ntiw)))/dtp enddo enddo else do k=1,nzm do i=1,nx - gq0(i,k,ntcw) = qc(i,k) - gq0(i,k,ntiw) = qi(i,k) + ten_q(i,k,ntcw) = (qc(i,k) - gq0(i,k,ntcw))/dtp + ten_q(i,k,ntiw) = (qi(i,k) - gq0(i,k,ntiw))/dtp enddo enddo if (ntlnc > 0) then do k=1,nzm do i=1,nx - gq0(i,k,ntlnc) = ncpl(i,k) + ten_q(i,k,ntlnc) = (ncpl(i,k) - gq0(i,k,ntlnc))/dtp gq0(i,k,ntinc) = ncpi(i,k) enddo enddo endif + if (ntinc > 0) then + do k=1,nzm + do i=1,nx + ten_q(i,k,ntinc) = (ncpi(i,k) - gq0(i,k,ntinc))/dtp + enddo + enddo + endif endif end subroutine shoc_run diff --git a/physics/PBL/SHOC/shoc.meta b/physics/PBL/SHOC/shoc.meta index a1550ce11..a3446d734 100644 --- a/physics/PBL/SHOC/shoc.meta +++ b/physics/PBL/SHOC/shoc.meta @@ -177,7 +177,7 @@ kind = kind_phys intent = in [u] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -185,7 +185,7 @@ kind = kind_phys intent = in [v] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -281,21 +281,21 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = inout + intent = in [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in [ntrac] standard_name = number_of_tracers long_name = number of tracers @@ -391,6 +391,38 @@ type = real kind = kind_phys intent = inout +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/YSU/ysuvdif.F90 b/physics/PBL/YSU/ysuvdif.F90 index 09ba28625..731bd6f85 100644 --- a/physics/PBL/YSU/ysuvdif.F90 +++ b/physics/PBL/YSU/ysuvdif.F90 @@ -38,7 +38,6 @@ end subroutine ysuvdif_init !! !------------------------------------------------------------------------------- subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & - utnp,vtnp,ttnp,qtnp, & swh,hlw,xmu,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & zorl,stress,hpbl,psim,psih, & @@ -48,7 +47,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & dt,kpbl1d,u10,v10,lssav,ldiag3d,qdiag3d, & flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & index_of_temperature,index_of_x_wind,index_of_y_wind, & - index_of_process_pbl,errmsg,errflg ) + index_of_process_pbl,ten_t,ten_u,ten_v,ten_q,errmsg,errflg) use machine , only : kind_phys ! @@ -97,10 +96,6 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & !---------------------------------------------------------------------------------- ! input/output variables ! - real(kind=kind_phys), dimension( :,: ) , & - intent(inout) :: utnp,vtnp,ttnp - real(kind=kind_phys), dimension( :,:,: ) , & - intent(inout) :: qtnp real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntqv, index_of_temperature, & index_of_x_wind, index_of_y_wind, index_of_process_pbl @@ -112,7 +107,8 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & intent(out) :: hpbl real(kind=kind_phys), dimension( : ), & intent(out) :: dusfc,dvsfc, dtsfc,dqsfc - + real(kind=kind_phys), dimension(:,:), intent(out) :: ten_t, ten_u, ten_v + real(kind=kind_phys), dimension(:,:,:), intent(out) :: ten_q ! error messages character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -186,7 +182,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & real(kind=kind_phys) :: dt2,rdt,spdk2,fm,fh,hol1,gamfac,vpert,prnum,prnum0 real(kind=kind_phys) :: ss,ri,qmean,tmean,alph,chi,zk,rl2,dk,sri real(kind=kind_phys) :: brint,dtodsd,dtodsu,rdz,dsdzt,dsdzq,dsdz2,rlamdz - real(kind=kind_phys) :: utend,vtend,ttend,qtend + real(kind=kind_phys) :: qtend real(kind=kind_phys) :: dtstep,govrthv real(kind=kind_phys) :: cont, conq, conw, conwrc, rovcp ! @@ -863,15 +859,14 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! do k = km,1,-1 do i = 1,im - ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) - ttnp(i,k) = ttnp(i,k)+ttend - dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k) + ten_t(i,k) = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) + dtsfc(i) = dtsfc(i)+ten_t(i,k)*cont*del(i,k) enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_t(i,k) endif endif ! @@ -975,17 +970,17 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! ! recover tendencies of heat and moisture ! + ten_q(:,:,:) = 0.0 do k = km,1,-1 do i = 1,im - qtend = (f3(i,k,1)-qx(i,k,1))*rdt - qtnp(i,k,1) = qtnp(i,k,1)+qtend - dqsfc(i) = dqsfc(i)+qtend*conq*del(i,k) + ten_q(i,k,ntqv) = (f3(i,k,ntqv)-qx(i,k,ntqv))*rdt + dqsfc(i) = dqsfc(i)+ten_q(i,k,ntqv)*conq*del(i,k) enddo enddo if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f3(:,:,1)-qx(:,:,1))*rdt + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_q(i,k,ntqv) endif endif ! @@ -993,8 +988,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & do ic = 2,ndiff do k = km,1,-1 do i = 1,im - qtend = (f3(i,k,ic)-qx(i,k,ic))*rdt - qtnp(i,k,ic) = qtnp(i,k,ic)+qtend + ten_q(i,k,ic) = (f3(i,k,ic)-qx(i,k,ic))*rdt enddo enddo enddo @@ -1002,7 +996,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & & .not. flag_for_pbl_generic_tend) then idtend = dtidx(100+ntoz,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + f3(:,:,ntoz)-qx(:,:,ntoz) + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_q(i,k,ntoz)*dtstep endif endif endif @@ -1078,23 +1072,21 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! do k = km,1,-1 do i = 1,im - utend = (f1(i,k)-ux(i,k))*rdt - vtend = (f2(i,k)-vx(i,k))*rdt - utnp(i,k) = utnp(i,k)+utend - vtnp(i,k) = vtnp(i,k)+vtend - dusfc(i) = dusfc(i) + utend*conwrc*del(i,k) - dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) + ten_u(i,k) = (f1(i,k)-ux(i,k))*rdt + ten_v(i,k) = (f2(i,k)-vx(i,k))*rdt + dusfc(i) = dusfc(i) + ten_u(i,k)*conwrc*del(i,k) + dvsfc(i) = dvsfc(i) + ten_v(i,k)*conwrc*del(i,k) enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-ux)*rdt + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_u(i,k) endif idtend = dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f2-vx)*rdt + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_v(i,k) endif endif ! diff --git a/physics/PBL/YSU/ysuvdif.meta b/physics/PBL/YSU/ysuvdif.meta index 0e2eb4ccd..59e747860 100644 --- a/physics/PBL/YSU/ysuvdif.meta +++ b/physics/PBL/YSU/ysuvdif.meta @@ -111,38 +111,6 @@ dimensions = () type = real intent = in -[utnp] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[vtnp] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ttnp] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qtnp] - standard_name = process_split_cumulative_tendency_of_tracers - long_name = updated tendency of the tracers due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout [swh] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep long_name = total sky shortwave heating rate @@ -503,6 +471,38 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/saYSU/shinhongvdif.F90 b/physics/PBL/saYSU/shinhongvdif.F90 index f56eae617..c663b0f61 100644 --- a/physics/PBL/saYSU/shinhongvdif.F90 +++ b/physics/PBL/saYSU/shinhongvdif.F90 @@ -38,7 +38,7 @@ end subroutine shinhongvdif_init !! !------------------------------------------------------------------------------- subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & - utnp,vtnp,ttnp,qtnp,ntrac,ndiff,ntcw,ntiw, & + ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & zorl,stress,hpbl,psim,psih, & landmask,heat,evap,wspd,br, & @@ -49,7 +49,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & dx,lssav,ldiag3d, & flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & index_of_process_pbl,index_of_temperature,index_of_x_wind, & - index_of_y_wind,errmsg,errflg ) + index_of_y_wind,ten_t,ten_u,ten_v,ten_q,errmsg,errflg ) use machine , only : kind_phys ! @@ -136,13 +136,6 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & real(kind=kind_phys), dimension(:,:) , & intent(in ) :: p2di, & phii -! 3D in&out - real(kind=kind_phys), dimension(:,:) , & - intent(inout) :: utnp, & - vtnp, & - ttnp - real(kind=kind_phys), dimension(:,:,:) , & - intent(inout) :: qtnp ! 2D in integer, dimension(:) , & intent(in ) :: landmask @@ -171,6 +164,8 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & dtsfc, & dqsfc + real(kind=kind_phys), intent(out) :: ten_t(:,:), ten_u(:,:), ten_v(:,:) + real(kind=kind_phys), intent(out) :: ten_q(:,:,:) real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_process_pbl, ntqv, & index_of_x_wind, index_of_y_wind, index_of_temperature @@ -191,7 +186,6 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & real(kind=kind_phys) :: dt2,rdt,spdk2,fm,fh,hol1,gamfac,vpert,prnum,prnum0 real(kind=kind_phys) :: ss,ri,qmean,tmean,alpha,chi,zk,rl2,dk,sri real(kind=kind_phys) :: brint,dtodsd,dtodsu,rdz,dsdzt,dsdzq,dsdz2,rlamdz - real(kind=kind_phys) :: utend,vtend,ttend,qtend real(kind=kind_phys) :: dtstep,govrthv real(kind=kind_phys) :: cont, conq, conw, conwrc real(kind=kind_phys) :: delxy,pu1,pth1,pq1 @@ -969,13 +963,12 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! do k = kte,kts,-1 do i = its,ite - ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) - ttnp(i,k) = ttnp(i,k)+ttend - dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k) + ten_t(i,k) = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) + dtsfc(i) = dtsfc(i)+ten_t(i,k)*cont*del(i,k) if(k.eq.kte) then - tflux_e(i,k) = ttend*dz8w2d(i,k) + tflux_e(i,k) = ten_t(i,k)*dz8w2d(i,k) else - tflux_e(i,k) = tflux_e(i,k+1) + ttend*dz8w2d(i,k) + tflux_e(i,k) = tflux_e(i,k+1) + ten_t(i,k)*dz8w2d(i,k) endif enddo enddo @@ -1096,15 +1089,15 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! ! recover tendencies of heat and moisture ! + ten_q(:,:,:) = 0.0 do k = kte,kts,-1 do i = its,ite - qtend = (f3(i,k,1)-qx(i,k,1))*rdt - qtnp(i,k,1) = qtnp(i,k,1)+qtend - dqsfc(i) = dqsfc(i)+qtend*conq*del(i,k) + ten_q(i,k,ntqv)= (f3(i,k,ntqv)-qx(i,k,ntqv))*rdt + dqsfc(i) = dqsfc(i)+ten_q(i,k,ntqv)*conq*del(i,k) if(k.eq.kte) then - qflux_e(i,k) = qtend*dz8w2d(i,k) + qflux_e(i,k) = ten_q(i,k,ntqv)*dz8w2d(i,k) else - qflux_e(i,k) = qflux_e(i,k+1) + qtend*dz8w2d(i,k) + qflux_e(i,k) = qflux_e(i,k+1) + ten_q(i,k,ntqv)*dz8w2d(i,k) endif tvflux_e(i,k) = tflux_e(i,k) + qflux_e(i,k)*ep1*thx(i,k) enddo @@ -1112,7 +1105,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f3(:,:,1)-qx(:,:,1)) + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_q(:,:,ntqv) endif endif ! print*,"qtnp:",maxval(qtnp(:,:,1)),minval(qtnp(:,:,1)) @@ -1138,8 +1131,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & if(ifvmix(ic)) then do k = kte,kts,-1 do i = its,ite - qtend = (f3(i,k,ic)-qx(i,k,ic))*rdt - qtnp(i,k,ic) = qtnp(i,k,ic)+qtend + ten_q(i,k,ic) = (f3(i,k,ic)-qx(i,k,ic))*rdt enddo enddo endif @@ -1148,7 +1140,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & & .not. flag_for_pbl_generic_tend) then idtend=dtidx(ntoz+100,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + qtend*(f3(:,:,ntoz)-qx(:,:,ntoz)) + dtend(:,:,idtend) = dtend(:,:,idtend) + ten_q(i,k,ntoz)*dtstep endif endif endif @@ -1234,22 +1226,20 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & ! do k = kte,kts,-1 do i = its,ite - utend = (f1(i,k)-ux(i,k))*rdt - vtend = (f2(i,k)-vx(i,k))*rdt - utnp(i,k) = utnp(i,k)+utend - vtnp(i,k) = vtnp(i,k)+vtend - dusfc(i) = dusfc(i) + utend*conwrc*del(i,k) - dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) + ten_u(i,k) = (f1(i,k)-ux(i,k))*rdt + ten_v(i,k) = (f2(i,k)-vx(i,k))*rdt + dusfc(i) = dusfc(i) + ten_u(i,k)*conwrc*del(i,k) + dvsfc(i) = dvsfc(i) + ten_v(i,k)*conwrc*del(i,k) enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend=dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f1-ux) + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_u(i,k) endif idtend=dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f2-vx) + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*ten_v(i,k) endif endif ! diff --git a/physics/PBL/saYSU/shinhongvdif.meta b/physics/PBL/saYSU/shinhongvdif.meta index 3e919d78f..1699bc329 100644 --- a/physics/PBL/saYSU/shinhongvdif.meta +++ b/physics/PBL/saYSU/shinhongvdif.meta @@ -111,38 +111,6 @@ dimensions = () type = real intent = in -[utnp] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[vtnp] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[ttnp] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qtnp] - standard_name = process_split_cumulative_tendency_of_tracers - long_name = updated tendency of the tracers due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout [ntrac] standard_name = number_of_tracers long_name = number of tracers @@ -480,6 +448,38 @@ dimensions = () type = integer intent = in +[ten_t] + standard_name = tendency_of_air_temperature + long_name = tendency of air temperature calculated by one physics scheme + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_u] + standard_name = tendency_of_x_wind + long_name = tendency of x wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_v] + standard_name = tendency_of_y_wind + long_name = tendency of y wind calculated by one physics scheme + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[ten_q] + standard_name = tendency_of_tracer_concentration + long_name = tendency of tracer concentration calculated by one physics scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMG/rrtmg_lw_post.F90 b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 index 36661973d..d2f3aef23 100644 --- a/physics/Radiation/RRTMG/rrtmg_lw_post.F90 +++ b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 @@ -11,8 +11,8 @@ module rrtmg_lw_post !> \section arg_table_rrtmg_lw_post_run Argument Table !! \htmlinclude rrtmg_lw_post_run.html !! - subroutine rrtmg_lw_post_run (im, levs, ltp, lm, kd, lslwr, lwhtr, & - tsfa, htlwc, htlw0, sfcflw, tsflw, sfcdlw, htrlw, lwhc, & + subroutine rrtmg_lw_post_run (im, levs, ltp, lm, kd, lslwr, lwhtr, & + tsfa, htlwc, htlw0, sfcflw, tsflw, sfcdlw, htrlw, lwhc, & errmsg, errflg) use machine, only: kind_phys diff --git a/physics/Radiation/RRTMG/rrtmg_sw_post.F90 b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 index 91c9ced16..b0c94d992 100644 --- a/physics/Radiation/RRTMG/rrtmg_sw_post.F90 +++ b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 @@ -25,7 +25,7 @@ subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & integer, intent(in) :: im, levr, levs, & ltp, nday, lm, kd - logical, intent(in) :: lsswr, swhtr + logical, intent(in) :: lsswr, swhtr real(kind=kind_phys), dimension(:), intent(in) :: sfcalb1, sfcalb2, & sfcalb3, sfcalb4 real(kind=kind_phys), dimension(:,:), intent(in) :: htswc, htsw0 @@ -45,7 +45,7 @@ subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, k1, k + integer :: i, k1, k, n ! Initialize CCPP error handling variables errmsg = '' diff --git a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index ac98437e9..dffbe2fff 100644 --- a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -331,7 +331,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) @@ -339,7 +339,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature units = K dimensions = (horizontal_loop_extent) @@ -347,7 +347,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = zonal wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -355,7 +355,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = meridional wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 9ea6a0ad1..4d6d6de8a 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -126,7 +126,7 @@ type = logical intent = in [ugrs] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = x component of layer wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -134,7 +134,7 @@ kind = kind_phys intent = in [vgrs] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = y component of layer wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -142,7 +142,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = layer mean air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -150,7 +150,7 @@ kind = kind_phys intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index 89bf1d840..6f0e113e0 100644 --- a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -202,7 +202,7 @@ kind = kind_phys intent = in [u] - standard_name = x_wind + standard_name = physics_timestep_initial_x_wind long_name = x component of layer wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -210,7 +210,7 @@ kind = kind_phys intent = in [v] - standard_name = y_wind + standard_name = physics_timestep_initial_y_wind long_name = y component of layer wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -218,7 +218,7 @@ kind = kind_phys intent = in [t3d] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = layer mean air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -226,7 +226,7 @@ kind = kind_phys intent = in [qvsh] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = water vapor specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -234,7 +234,7 @@ kind = kind_phys intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index e556e03ba..b6a04aea6 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -109,7 +109,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_of_new_state_at_surface_adjacent_layer + standard_name = x_wind_at_surface_adjacent_layer long_name = x component of 1st model layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -117,7 +117,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_of_new_state_at_surface_adjacent_layer + standard_name = y_wind_at_surface_adjacent_layer long_name = y component of 1st model layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -148,7 +148,7 @@ type = logical intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature units = K dimensions = (horizontal_loop_extent) @@ -156,7 +156,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = 1st model layer specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index 470b01a90..73dca0679 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -56,7 +56,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature units = K dimensions = (horizontal_loop_extent) @@ -64,7 +64,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = 1st model layer specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) @@ -235,7 +235,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = x component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -243,7 +243,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = y component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index 04c26399f..1133246a7 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -119,7 +119,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = x component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -127,7 +127,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = y component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -158,7 +158,7 @@ type = logical intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature units = K dimensions = (horizontal_loop_extent) @@ -166,7 +166,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = surface layer mean specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta index 7b3bc0a49..79e5aede9 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.meta +++ b/physics/SFC_Models/Lake/CLM/clm_lake.meta @@ -170,7 +170,7 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = temperature updated by physics units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -194,7 +194,7 @@ kind = kind_phys intent = in [qvcurr] - standard_name = specific_humidity_of_new_state_at_surface_adjacent_layer + standard_name = specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent) @@ -202,7 +202,7 @@ kind = kind_phys intent = in [gu0] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = zonal wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -210,7 +210,7 @@ kind = kind_phys intent = in [gv0] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = meridional wind updated by physics units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -732,7 +732,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -740,7 +740,7 @@ kind = kind_phys intent = in [qv1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Lake/Flake/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta index 22ab62d1e..9daa77d54 100644 --- a/physics/SFC_Models/Lake/Flake/flake_driver.meta +++ b/physics/SFC_Models/Lake/Flake/flake_driver.meta @@ -23,7 +23,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -31,7 +31,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 3270c9de6..02a93cb4c 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -185,7 +185,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature units = K dimensions = (horizontal_loop_extent) @@ -193,7 +193,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = 1st model layer specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index ff5d19f5a..b5bd13b8b 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -365,7 +365,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = zonal wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -373,7 +373,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = meridional wind at lowest model layer units = m s-1 dimensions = (horizontal_loop_extent) @@ -381,7 +381,7 @@ kind = kind_phys intent= in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -389,7 +389,7 @@ kind = kind_phys intent= in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta index bc4d358e3..929364df2 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -153,7 +153,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) @@ -746,7 +746,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = mean temperature at lowest model layer units = K dimensions = (horizontal_loop_extent) @@ -754,7 +754,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) @@ -762,7 +762,7 @@ kind = kind_phys intent = in [qc] - standard_name = cloud_liquid_water_mixing_ratio_at_surface_adjacent_layer + standard_name = physics_timestep_initial_cloud_liquid_water_mixing_ratio_at_surface_adjacent_layer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index 69268ee19..1f0721f12 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -71,7 +71,7 @@ kind = kind_phys intent = in [u1] - standard_name = x_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_x_wind_at_surface_adjacent_layer long_name = x component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -79,7 +79,7 @@ kind = kind_phys intent = in [v1] - standard_name = y_wind_at_surface_adjacent_layer + standard_name = physics_timestep_initial_y_wind_at_surface_adjacent_layer long_name = y component of surface layer wind units = m s-1 dimensions = (horizontal_loop_extent) @@ -110,7 +110,7 @@ type = logical intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature units = K dimensions = (horizontal_loop_extent) @@ -118,7 +118,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = surface layer mean specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta index 3920e3820..91841de61 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta @@ -55,7 +55,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature units = K dimensions = (horizontal_loop_extent) @@ -63,7 +63,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = surface layer mean specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta index 8436cdd1e..d2919c593 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta @@ -111,7 +111,7 @@ kind = kind_phys intent = in [t1] - standard_name = air_temperature_at_surface_adjacent_layer + standard_name = physics_timestep_initial_air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature units = K dimensions = (horizontal_loop_extent) @@ -119,7 +119,7 @@ kind = kind_phys intent = in [q1] - standard_name = specific_humidity_at_surface_adjacent_layer + standard_name = physics_timestep_initial_specific_humidity_at_surface_adjacent_layer long_name = surface layer mean specific humidity units = kg kg-1 dimensions = (horizontal_loop_extent) diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 9a18616b1..0617aeca4 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -49,7 +49,7 @@ type = integer intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index ba630d101..5ba8dd9e5 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -386,7 +386,7 @@ kind = kind_phys intent = in [tk3d] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -394,7 +394,7 @@ kind = kind_phys intent = inout [us3d] - standard_name = x_wind_of_new_state + standard_name = x_wind long_name = updated x-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -402,7 +402,7 @@ kind = kind_phys intent = inout [vs3d] - standard_name = y_wind_of_new_state + standard_name = y_wind long_name = updated y-direction wind units = m s-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -410,7 +410,7 @@ kind = kind_phys intent = inout [spechum] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = water vapor specific humidity updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -634,7 +634,7 @@ type = integer intent = in [qgrs] - standard_name = tracer_concentration + standard_name = physics_timestep_initial_tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -642,7 +642,7 @@ kind = kind_phys intent = inout [gq0] - standard_name = tracer_concentration_of_new_state + standard_name = tracer_concentration long_name = tracer concentration updated by physics units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) @@ -708,7 +708,7 @@ type = integer intent = in [nwfa] - standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state + standard_name = mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -717,7 +717,7 @@ intent = inout optional = True [nifa] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state + standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols units = kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/tools/get_phi_fv3.meta b/physics/tools/get_phi_fv3.meta index 5c162c746..cdab3db5f 100644 --- a/physics/tools/get_phi_fv3.meta +++ b/physics/tools/get_phi_fv3.meta @@ -31,7 +31,7 @@ kind = kind_phys intent = in [gt0] - standard_name = air_temperature_of_new_state + standard_name = air_temperature long_name = updated air temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -39,7 +39,7 @@ kind = kind_phys intent = in [gq01] - standard_name = specific_humidity_of_new_state + standard_name = specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/physics/tools/get_prs_fv3.meta b/physics/tools/get_prs_fv3.meta index 4cdad7566..c3927ed02 100644 --- a/physics/tools/get_prs_fv3.meta +++ b/physics/tools/get_prs_fv3.meta @@ -46,7 +46,7 @@ kind = kind_phys intent = in [tgrs] - standard_name = air_temperature + standard_name = physics_timestep_initial_air_temperature long_name = mid-layer temperature units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -54,7 +54,7 @@ kind = kind_phys intent = in [qgrs1] - standard_name = specific_humidity + standard_name = physics_timestep_initial_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 dimensions = (horizontal_loop_extent,vertical_layer_dimension)