From d06890a95d91ed5b946527e7479a4190e4a93164 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 14:08:18 -0700 Subject: [PATCH] Added code necessary for the generic deep convection interstitial schemes - created GFS_DCNV_generic.f90 with modules for pre and post - moved code from GFS_physics_driver.f90 to this file - call the new subroutines from GFS_physics_driver.f90 - edited makefile to compile new file - edits to sasasdeep_run table in mfdeepcnv.f - NOT TESTED YET (committing to test on Theia) --- GFS_layer/GFS_physics_driver.F90 | 108 +++++++++++++++------------- makefile | 2 +- physics/GFS_DCNV_generic.f90 | 118 +++++++++++++++++++++++++++++++ physics/mfdeepcnv.f | 2 +- 4 files changed, 179 insertions(+), 51 deletions(-) create mode 100644 physics/GFS_DCNV_generic.f90 diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 249d8fd6a..5185c6811 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -4,7 +4,7 @@ module module_physics_driver use physcons, only: con_cp, con_fvirt, con_g, con_rd, & con_rv, con_hvap, con_hfus, & con_rerth, con_pi, rhc_max, dxmin,& - dxinv, pa2mb, rlapse + dxinv, pa2mb, rlapse use cs_conv, only: cs_convr use ozne_def, only: levozp, oz_coeff, oz_pres use h2o_def, only: levh2o, h2o_coeff, h2o_pres @@ -15,6 +15,9 @@ module module_physics_driver GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type + use sasas_deep, only: sasasdeep_run + use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run + use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run implicit none @@ -27,7 +30,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: hsub = con_hvap+con_hfus real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) real(kind=kind_phys), parameter :: onebg = 1.0/con_g - real(kind=kind_phys), parameter :: albdf = 0.06 + real(kind=kind_phys), parameter :: albdf = 0.06 real(kind=kind_phys) tf, tcr, tcrf parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) @@ -422,14 +425,14 @@ subroutine GFS_physics_driver & flag_cice logical, dimension(Model%ntrac-Model%ncld+2,2) :: & - otspt + otspt !--- REAL VARIABLES real(kind=kind_phys) :: & dtf, dtp, rhbbot, rhbtop, rhpbl, frain, tem, tem1, tem2, & xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, & - !--- experimental for shoc sub-stepping - dtshoc + !--- experimental for shoc sub-stepping + dtshoc real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & ccwfac, garea, dlength, cumabs, cice, zice, tice, gflx, & @@ -460,7 +463,10 @@ subroutine GFS_physics_driver & del, rhc, dtdt, dudt, dvdt, gwdcu, gwdcv, dtdtc, rainp, & ud_mf, dd_mf, dt_mf, prnum, dkt, sigmatot, sigmafrac - !--- GFDL modification for FV3 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & + initial_u, initial_v, initial_t, initial_qv + + !--- GFDL modification for FV3 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs+1) ::& del_gz @@ -468,7 +474,7 @@ subroutine GFS_physics_driver & dqdt real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%nctp) :: & - sigmai, vverti + sigmai, vverti real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,oz_coeff+5) :: & dq3dt_loc @@ -477,7 +483,7 @@ subroutine GFS_physics_driver & !--- in clw, the first two varaibles are cloud water and ice. !--- from third to ntrac are convective transportable tracers, !--- third being the ozone, when ntrac=3 (valid only with ras) - !--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow, + !--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow, !--- rain, and their number real(kind=kind_phys), allocatable :: & clw(:,:,:), qpl(:,:), qpi(:,:), ncpl(:,:), ncpi(:,:), & @@ -1012,7 +1018,7 @@ subroutine GFS_physics_driver & Model%lsm, lprnt, ipr, & ! --- input/outputs: zice, cice, tice, Sfcprop%weasd, Sfcprop%tsfc, & - Sfcprop%tprcp, stsoil, ep1d, & + Sfcprop%tprcp, stsoil, ep1d, & ! --- outputs: Sfcprop%snowd, qss, snowmt, gflx, Diag%cmm, Diag%chh, evap, & hflx) @@ -1493,17 +1499,19 @@ subroutine GFS_physics_driver & ! &,' lat=',lat,' kdt=',kdt,' me=',me ! if (lprnt) write(7000,*)' bef convection gv0=',gv0(ipr,:) - if (Model%ldiag3d) then - dtdt(:,:) = Stateout%gt0(:,:) - dudt(:,:) = Stateout%gu0(:,:) - dvdt(:,:) = Stateout%gv0(:,:) - elseif (Model%cnvgwd) then - dtdt(:,:) = Stateout%gt0(:,:) - endif ! end if_ldiag3d/cnvgwd + ! if (Model%ldiag3d) then + ! dtdt(:,:) = Stateout%gt0(:,:) + ! dudt(:,:) = Stateout%gu0(:,:) + ! dvdt(:,:) = Stateout%gv0(:,:) + ! elseif (Model%cnvgwd) then + ! dtdt(:,:) = Stateout%gt0(:,:) + ! endif ! end if_ldiag3d/cnvgwd + ! + ! if (Model%ldiag3d .or. Model%lgocart) then + ! dqdt(:,:,1) = Stateout%gq0(:,:,1) + ! endif ! end if_ldiag3d/lgocart - if (Model%ldiag3d .or. Model%lgocart) then - dqdt(:,:,1) = Stateout%gq0(:,:,1) - endif ! end if_ldiag3d/lgocart + call GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) #ifdef GFS_HYDRO call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & @@ -1857,26 +1865,28 @@ subroutine GFS_physics_driver & ! write(0,*)' aftcnvgq1=',(gq0(ipr,k,ntcw),k=1,levs) ! endif ! - do i = 1, im - Diag%rainc(:) = frain * rain1(:) - enddo +! do i = 1, im +! Diag%rainc(:) = frain * rain1(:) +! enddo +! ! +! if (Model%lssav) then +! Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * dtf +! Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) ! - if (Model%lssav) then - Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * dtf - Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) - - if (Model%ldiag3d) then - Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain - Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain - Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-dudt(:,:)) * frain - Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-dvdt(:,:)) * frain - - Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) - Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) - Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) - endif ! if (ldiag3d) +! if (Model%ldiag3d) then +! Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain +! Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain +! Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-dudt(:,:)) * frain +! Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-dvdt(:,:)) * frain +! +! Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) +! Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) +! Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) +! endif ! if (ldiag3d) +! +! endif ! end if_lssav - endif ! end if_lssav + call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then @@ -1905,7 +1915,7 @@ subroutine GFS_physics_driver & if (Model%cnvgwd) then ! call convective gravity wave drag -! --- ... calculate maximum convective heating rate +! --- ... calculate maximum convective heating rate ! cuhr = temperature change due to deep convection cumabs(:) = 0.0 @@ -2239,7 +2249,7 @@ subroutine GFS_physics_driver & Stateout%gq0(1,1,1), clw(1,1,1), clw(1,1,2), qpi, qpl,rhc, & Model%sup, Tbd%phy_f3d(1,1,Model%ntot3d-2), & Stateout%gq0(1,1,Model%ntke), hflx, evap, prnum, & - Tbd%phy_f3d(1,1,Model%ntot3d-1), Tbd%phy_f3d(1,1,Model%ntot3d),& + Tbd%phy_f3d(1,1,Model%ntot3d-1), Tbd%phy_f3d(1,1,Model%ntot3d),& lprnt, ipr, ncpl, ncpi, kdt) if ((Model%ntlnc > 0) .and. (Model%ntinc > 0) .and. (Model%ncld >= 2)) then @@ -2429,13 +2439,13 @@ subroutine GFS_physics_driver & ncpr(:,:) = 0. ncps(:,:) = 0. Tbd%phy_f3d(:,:,1) = Tbd%phy_f3d(:,:,Model%ntot3d-2) ! clouds from shoc - else + else clw(:,:,1) = Stateout%gq0(:,:,Model%ntiw) ! ice clw(:,:,2) = Stateout%gq0(:,:,Model%ntcw) ! water - qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) - qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) - ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) - ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) + qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) + qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) + ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) + ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) Tbd%phy_f3d(:,:,1) = Tbd%phy_f3d(:,:,Model%ntot3d-2) ! clouds from shoc end if elseif ((Model%imfdeepcnv >= 0) .or. (Model%imfshalcnv > 0)) then @@ -2471,10 +2481,10 @@ subroutine GFS_physics_driver & else clw(:,:,1) = Stateout%gq0(:,:,Model%ntiw) ! ice clw(:,:,2) = Stateout%gq0(:,:,Model%ntcw) ! water - qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) - qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) - ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) - ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) + qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) + qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) + ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) + ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) Tbd%phy_f3d(:,:,1) = min(1.0, Tbd%phy_f3d(:,:,1)+cnvc(:,:)) endif endif @@ -2813,7 +2823,7 @@ subroutine moist_bud(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & ! endif enddo return - + end subroutine moist_bud !> @} diff --git a/makefile b/makefile index 2a92e1523..a0d1cc2fa 100644 --- a/makefile +++ b/makefile @@ -119,6 +119,7 @@ SRCS_f90 = \ ./physics/gcm_shoc.f90 \ ./physics/gcycle.f90 \ ./physics/get_prs_fv3.f90 \ + ./physics/GFS_DCNV_generic.f90 \ ./physics/h2ointerp.f90 \ ./physics/m_micro_driver.f90 \ ./physics/module_nst_model.f90 \ @@ -190,4 +191,3 @@ include ./depend ifneq (clean,$(findstring clean,$(MAKECMDGOALS))) -include depend endif - diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 new file mode 100644 index 000000000..7a5b1fae9 --- /dev/null +++ b/physics/GFS_DCNV_generic.f90 @@ -0,0 +1,118 @@ +!> \file GFS_DCNV_generic.f90 +!! Contains code related to deep convective schemes to be used within the GFS physics suite. + + module GFS_DCNV_generic_pre + + contains + + subroutine GFS_DCNV_generic_pre_init () + end subroutine GFS_DCNV_generic_pre_init + + subroutine GFS_DCNV_generic_pre_finalize() + end subroutine GFS_DCNV_generic_pre_finalize + +!> \section arg_table_GFS_DCNV_generic_pre_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | initial_u | x_wind_initial | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | +!! | initial_v | y_wind_initial | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | +!! + subroutine GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_stateout_type, GFS_grid_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_grid_type), intent(in) :: Grid + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(inout) :: initial_u, initial_v, intial_t, intial_qv + + if (Model%ldiag3d) then + initial_t(:,:) = Stateout%gt0(:,:) + initial_u(:,:) = Stateout%gu0(:,:) + initial_v(:,:) = Stateout%gv0(:,:) + elseif (Model%cnvgwd) then + initial_t(:,:) = Stateout%gt0(:,:) + endif ! end if_ldiag3d/cnvgwd + + if (Model%ldiag3d .or. Model%lgocart) then + initial_qv(:,:) = Stateout%gq0(:,:,1) + endif ! end if_ldiag3d/lgocart + + end subroutine GFS_DCNV_generic_pre_run + + end module + + module GFS_DCNV_generic_post + + contains + + subroutine GFS_DCNV_generic_post_init () + end subroutine GFS_DCNV_generic_post_init + + subroutine GFS_DCNV_generic_post_finalize () + end subroutine GFS_DCNV_generic_post_finalize + +!> \section arg_table_GFS_PBL_generic_post_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | +!! | rain1 | instantaneous_rainfall_amount | instantaneous rainfall amount | m | 1 | real | kind_phys | in | F | +!! | cld1d | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | in | F | +!! | initial_u | x_wind_initial | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | +!! | initial_v | y_wind_initial | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | +!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! + subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type + use physcons, only: con_g + + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_diag_type), intent(inout) :: Diag + + real(kind=kind_phys), intent(in) :: frain + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: rain1, cld1d + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_u, initial_v, intial_t, intial_qv + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: ud_mf, dd_mf, dt_mf + + integer :: i + + + do i = 1, size(Grid%xlon,1) + Diag%rainc(:) = frain * rain1(:) + enddo + ! + if (Model%lssav) then + Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * Model%dtf + Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) + + if (Model%ldiag3d) then + Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain + Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain + Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-initial_u(:,:)) * frain + Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-initial_v(:,:)) * frain + + Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) + Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) + Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) + endif ! if (ldiag3d) + + endif ! end if_lssav + end subroutine GFS_DCNV_generic_post_run + + end module diff --git a/physics/mfdeepcnv.f b/physics/mfdeepcnv.f index 9f204dd70..8de335e60 100755 --- a/physics/mfdeepcnv.f +++ b/physics/mfdeepcnv.f @@ -56,7 +56,7 @@ end subroutine sasasdeep_finalize !! | ncloud | number_of_hydrometeors | number of hydrometeors | count | 0 | integer | | in | F | !! | ud_mf | atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | !! | dd_mf | atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | -!! | dt_mf | atmosphere_updraft_convective_mass_flux_at_cloud_top | ud_mf at cloud top | kg m-2 | 2 | real | kind_phys | out | F | +!! | dt_mf | atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | out | F | !! | cnvw | atmosphere_convective_cloud_water_specific_humidity | convective cloud water | kg kg-1 | 2 | real | kind_phys | out | F | !! | cnvc | cloud_binary_mask | convective cloud cover | flag | 2 | real | kind_phys | out | F | !!