diff --git a/.gitmodules b/.gitmodules index 9a9ceb71f..7d8e73982 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,9 +8,13 @@ branch = main [submodule "physics/SFC_Layer/MYNN/MYNN"] path = physics/SFC_Layer/MYNN/MYNN - url = https://github.com/NCAR/MYNN-SFC - branch = ccpp/dev + # url = https://github.com/NCAR/MYNN-SFC + # branch = ccpp/dev + url = https://github.com/scrasmussen/MYNN-SFC + branch = mynn-sfc-remove-physcons [submodule "physics/CONV/C3"] path = physics/CONV/C3 - url = https://github.com/ufs-community/c3 - branch = main + # url = https://github.com/ufs-community/c3 + # branch = main + url = https://github.com/scrasmussen/c3 + branch = c3-remove-physcons diff --git a/physics/CONV/C3 b/physics/CONV/C3 index 24fd7fc04..a1645fb55 160000 --- a/physics/CONV/C3 +++ b/physics/CONV/C3 @@ -1 +1 @@ -Subproject commit 24fd7fc0483930abbeb5fff0cceea26511250e25 +Subproject commit a1645fb55042fb4f940dae2dbdcab868c5611c52 diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index 043c53293..bb1f2e1e4 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -14,25 +14,12 @@ module cs_conv !--------------------------------------------------------------------------------- ! use machine , only : kind_phys - use physcons, only : cp => con_cp, grav => con_g, & - & rair => con_rd, rvap => con_rv, & - & cliq => con_cliq, cvap => con_cvap, & - & epsv => con_eps, epsvm1 => con_epsm1, & - & epsvt => con_fvirt, & - & el => con_hvap, emelt => con_hfus, t0c => con_t0c use funcphys, only : fpvs ! this is saturation vapor pressure in funcphys.f - - implicit none private ! Make default type private to the module real(kind_phys), parameter :: zero=0.0d0, one=1.0d0, half=0.5d0 - real(kind_phys), parameter :: cpoel=cp/el, cpoesub=cp/(el+emelt), esubocp=1.0/cpoesub, & - elocp=el/cp, oneocp=one/cp, gocp=grav/cp, gravi=one/grav,& - emeltocp=emelt/cp, cpoemelt=cp/emelt, epsln=1.e-10_kind_phys - - real(kind_phys), parameter :: fact1=(cvap-cliq)/rvap, fact2=el/rvap-fact1*t0c !< to calculate d(qs)/dT logical, parameter :: adjustp=.true. ! logical, parameter :: adjustp=.false. @@ -163,7 +150,14 @@ 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,ten_t,ten_u,ten_v,ten_q,ten_clw,errmsg,errflg) + mp_phys,ten_t,ten_u,ten_v,ten_q,ten_clw, & + cp, grav, & + rair, rvap, & + cliq, cvap, & + epsv, epsvm1, & + epsvt, & + el, emelt, t0c, & + errmsg,errflg) implicit none @@ -204,7 +198,6 @@ 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) - real(kind_phys), intent(out), dimension(:,:), optional :: qlcn, qicn, w_upi,cnv_mfd, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi @@ -269,6 +262,27 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & real(kind_phys) :: ftintm, wrk, wrk1, tem, new_qv integer i, k, n, ISTS, IENS, kp1 + real(kind_phys), intent(in) :: cp !< specific heat of dry air at constant pressure [J kg-1 K-1] + real(kind_phys), intent(in) :: grav !< gravitational acceleration [m s-2] + real(kind_phys), intent(in) :: rair !< ideal gas constant for dry air [J kg-1 K-1] + real(kind_phys), intent(in) :: rvap !< ideal gas constant for water vapor [J kg-1 K-1] + real(kind_phys), intent(in) :: cliq !< specific heat of liquid water at constant pressure [J kg-1 K-1] + real(kind_phys), intent(in) :: cvap !< specific heat of water vapor at constant pressure [J kg-1 K-1] + real(kind_phys), intent(in) :: epsv !< rd/rv + real(kind_phys), intent(in) :: epsvm1 !< (rd/rv) - 1 + real(kind_phys), intent(in) :: epsvt !< (rv/rd) - 1 + real(kind_phys), intent(in) :: el !< latent heat of evaporation/sublimation [J kg-1] + real(kind_phys), intent(in) :: emelt !< latent heat of fusion [J kg-1] + real(kind_phys), intent(in) :: t0c !< temperature at 0 degrees Celsius [K] + + ! real(kind_phys), intent(in) :: + real(kind_phys) :: cpoel, cpoesub, esubocp, & + elocp, oneocp, gocp, gravi,& + emeltocp, cpoemelt, epsln + real(kind_phys) :: fact1, fact2 + + + !DD borrowed from RAS to go form total condensate to ice/water separately ! parameter (tf=130.16, tcr=160.16, tcrf=1.0/(tcr-tf),tcl=2.0) ! parameter (tf=230.16, tcr=260.16, tcrf=1.0/(tcr-tf)) @@ -286,6 +300,20 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & new_clw = clw ten_clw = 0.0 + ! Initialize parameters + cpoel=cp/el + cpoesub=cp/(el+emelt) + esubocp=1.0/cpoesub + elocp=el/cp + oneocp=one/cp + gocp=grav/cp + gravi=one/grav + emeltocp=emelt/cp + cpoemelt=cp/emelt + epsln=1.e-10_kind_phys + fact1=(cvap-cliq)/rvap + fact2=el/rvap-fact1*t0c + ! lprnt = kdt == 1 .and. mype == 38 ! ipr = 43 @@ -420,7 +448,12 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & sigmai, sigma, vverti, & ! input/output !DDsigma - do_aw, do_awdd, flx_form) + do_aw, do_awdd, flx_form, rair, & + oneocp, gravi, grav, gocp, fact2, & + fact1, esubocp, epsvt, epsvm1, & + epsv, elocp, el, cpoesub, & + cpoemelt, cpoel, cp, epsln, & + emeltocp, emelt) ! ! !DD detrainment has to be added in for GFS @@ -611,17 +644,25 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & ! sigmai, sigma, vverti, & ! input/output !DDsigma - do_aw, do_awdd, flx_form) + do_aw, do_awdd, flx_form, rair, & + oneocp, gravi, grav, gocp, fact2, & + fact1, esubocp, epsvt, epsvm1, & + epsv, elocp, el, cpoesub, & + cpoemelt, cpoel, cp, epsln, & + emeltocp, emelt) ! IMPLICIT NONE + real(kind_phys), intent(in) :: oneocp, gravi, grav, gocp, fact2, fact1, & + esubocp, epsvt, epsvm1, epsv, elocp, el, cpoesub, cpoemelt, cpoel, & + cp, epsln, emeltocp, emelt Integer, parameter :: ntrq=4 ! starting index for tracers INTEGER, INTENT(IN) :: im, IJSDIM, KMAX, NTR, mype, nctp, ipr !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! switch to apply Arakawa-Wu to the tendencies logical, intent(in) :: otspt1(ntr), otspt2(ntr), lprnt REAL(kind_phys),intent(in) :: DELP (IJSDIM, KMAX) REAL(kind_phys),intent(in) :: DELPINV (IJSDIM, KMAX) -! + real(kind_phys), intent(in) :: rair !< ideal gas constant for dry air [J kg-1 K-1] ! [OUTPUT] REAL(kind_phys), INTENT(OUT) :: GTT (IJSDIM, KMAX ) ! heating rate REAL(kind_phys), INTENT(OUT) :: GTQ (IJSDIM, KMAX, NTR) ! change in q @@ -995,7 +1036,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDPM , FDQS , GAM , & ! input lprnt, ipr, & ISTS , IENS , & !) ! input - gctbl, gcqbl,gdq,gcwbl, gcqlbl, gcqibl, gctrbl) ! sub cloud tendencies + gctbl, gcqbl,gdq,gcwbl, gcqlbl, gcqibl, gctrbl, & + oneocp, grav, el) ! sub cloud tendencies ! !> -# Compute CAPE and CIN ! @@ -1092,7 +1134,9 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions KB , CTP , ISTS , IENS , & ! input gctm , gcqm(:,:,CTP), gcwm(:,:,CTP), gchm(:,:,CTP),& gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water - lprnt , ipr ) + lprnt , ipr, & + oneocp, grav, fact1, fact2, epsvt, & + epsvm1, epsv, emelt, el, cp) ! !> -# Call cumbmx() to compute cloud base mass flux CALL CUMBMX(IJSDIM, KMAX, & !DD dimensions @@ -1100,7 +1144,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ACWF , GCYT(:,CTP), GDZM , & ! input GDW , GDQS , DELP , & ! input KT (:,CTP), KTMX(CTP) , KB , & ! input - DELTI , ISTS , IENS ) + DELTI , ISTS , IENS , & ! input + oneocp, el, epsln ) !DDsigma - begin sigma computation ! At this point cbmfx is updated and we have everything we need to compute sigma @@ -1337,7 +1382,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CBMFX , GCYT , DELPInv , GCHT , GCQT , & ! input GCLT , GCIT , GCUT , GCVT , GDQ(:,:,iti),& ! input gctrt , & - KT , ISTS , IENS, nctp ) ! input + KT , ISTS , IENS, nctp, oneocp, el) ! input endif !for now area fraction of the downdraft is zero, it will be computed @@ -1450,8 +1495,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions sigmad, do_aw , do_awdd, flx_form, & ! DDsigma input dtmelt, dtevap, dtsubl, & ! DDsigma input dtdwn , dqvdwn, dqldwn, dqidwn, & ! DDsigma input - dtrdwn, & - KB , KTMXT , ISTS , IENS ) ! input + dtrdwn, & ! input + KB , KTMXT , ISTS , IENS, & ! input + oneocp, gocp, esubocp, emeltocp, emelt, & + elocp, el, cp) + ! sigma = sigma + sigmad @@ -1466,7 +1514,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDH , GDQ , GDQ(:,:,iti) , & ! input GDU , GDV , & ! input DELPINV , GMFLX , GMFX0 , & ! input - KTMXT , CPRES , kb, ISTS , IENS ) ! input + KTMXT , CPRES , kb, ISTS , IENS, oneocp, el ) ! input else CALL CUMSBW(IM , IJSDIM, KMAX , & !DD dimensions GTU , GTV , & ! modified @@ -1707,7 +1755,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CALL CUMFXR(IM , IJSDIM, KMAX , NTR , & !DD dimensions GTQ , & ! modified GDQ , DELP , DELTA , KTMXT , IMFXR, & ! input - ISTS , IENS ) ! input + ISTS , IENS, gravi ) ! input ! ! do k=1,kmax @@ -1865,16 +1913,18 @@ SUBROUTINE CUMBAS & ! cloud base GDPM , FDQS , GAM , & ! input lprnt, ipr, & ISTS , IENS , gctbl, gcqbl ,gdq, & - gcwbl, gcqlbl, gcqibl, gctrbl ) ! input !DDsigmadiag add updraft profiles below cloud base -! -! + gcwbl, gcqlbl, gcqibl, gctrbl, & ! input !DDsigmadiag add updraft profiles below cloud base + oneocp, grav, el) + + IMPLICIT NONE ! integer, parameter :: crtrh=0.80 integer, parameter :: crtrh=0.70 INTEGER, INTENT(IN) :: IJSDIM, KMAX , ntr, ntrq ! DD, for GFS, pass in integer ipr logical lprnt -! + real(kind_phys), intent(in) :: oneocp, grav, el + ! [OUTPUT] INTEGER KB (IJSDIM) ! cloud base REAL(kind_phys) GCYM (IJSDIM, KMAX) ! norm. mass flux (half lev) @@ -2083,7 +2133,9 @@ SUBROUTINE CUMUP & !! in-cloud properties ! CPRES , WCB , ERMR , & ! input KB , CTP , ISTS , IENS, & ! input gctm , gcqm , gcwm , gchm, gcwt,& - gclm, gcim , gctrm , lprnt, ipr ) + gclm, gcim , gctrm , lprnt, ipr,& + oneocp, grav, fact1, fact2, epsvt, & + epsvm1, epsv, emelt, el, cp) ! !DD AW the above line of arguments were previously local, and often scalars. ! Dimensions were added to them to save profiles for each grid point. @@ -2092,7 +2144,8 @@ SUBROUTINE CUMUP & !! in-cloud properties INTEGER, INTENT(IN) :: IJSDIM, KMAX, NTR, ipr , ntrq ! DD, for GFS, pass in logical :: lprnt -! + real(kind_phys), intent(in) :: oneocp, grav, fact1, fact2, epsvt + real(kind_phys), intent(in) :: epsvm1, epsv, emelt, el, cp ! [OUTPUT] REAL(kind_phys) ACWF (IJSDIM) !< cloud work function REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid water*eta @@ -2740,12 +2793,14 @@ SUBROUTINE CUMBMX & !! cloud base mass flux ACWF , GCYT , GDZM , & ! input GDW , GDQS , DELP , & ! input KT , KTMX , KB , & ! input - DELT , ISTS , IENS ) ! input + DELT , ISTS , IENS, & ! input + oneocp, el, epsln) ! input ! ! IMPLICIT NONE INTEGER, INTENT(IN) :: IJSDIM, KMAX ! DD, for GFS, pass in + real(kind_phys), intent(in) :: oneocp, el, epsln ! ! [MODIFY] REAL(kind_phys) CBMFX (IJSDIM) !< cloud base mass flux @@ -2888,11 +2943,12 @@ SUBROUTINE CUMDET & !! detrainment CBMFX , GCYT , DELPI , GCHT , GCQT , & ! input GCLT , GCIT , GCUT , GCVT , GDQI , & ! input gctrt, & - KT , ISTS , IENS , nctp ) ! input + KT , ISTS , IENS , nctp, oneocp, el) ! input ! IMPLICIT NONE INTEGER, INTENT(IN) :: im, IJSDIM, KMAX, NTR, nctp, ntrq !! DD, for GFS, pass in + real(kind_phys), intent(in) :: oneocp, el ! ! [MODIFY] REAL(kind_phys) GTT (IJSDIM, KMAX) !< temperature tendency @@ -2962,12 +3018,14 @@ SUBROUTINE CUMSBH & !! adiabat. descent GDH , GDQ , GDQI , & ! input GDU , GDV , & ! input DELPI , GMFLX , GMFX0 , & ! input - KTMX , CPRES , KB, ISTS , IENS ) ! input + KTMX , CPRES , KB, ISTS , IENS, & ! input + oneocp, el) ! ! IMPLICIT NONE INTEGER, INTENT(IN) :: IJSDIM, IM, KMAX, NTR, ntrq !! DD, for GFS, pass in + real(kind_phys), intent(in) :: oneocp, el ! ! [MODIFY] REAL(kind_phys) GTT (IJSDIM, KMAX) !< Temperature tendency @@ -3164,8 +3222,10 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation sigmad, do_aw , do_awdd, flx_form, & !DDsigma input gtmelt, gtevap, gtsubl, & !DDsigma input dtdwn , dqvdwn, dqldwn, dqidwn, & !DDsigma input - dtrdwn, & - KB , KTMX , ISTS , IENS ) ! input + dtrdwn, & ! input + KB , KTMX , ISTS , IENS, & ! input + oneocp, gocp, esubocp, emeltocp, emelt,& + elocp, el, cp) ! ! DD AW : modify to get eddy fluxes and microphysical tendencies for AW ! @@ -3173,6 +3233,9 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR , ntrq, nctp !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form + real(kind_phys), intent(in) :: oneocp, gocp, esubocp, emeltocp, emelt, & + elocp, el, cp + ! ! [MODIFY] REAL(kind_phys) GTT (IJSDIM, KMAX) !< Temperature tendency @@ -3855,10 +3918,11 @@ SUBROUTINE CUMSBR & !! Tracer Subsidence GDR , DELP , & ! input GMFLX , KTMX , OTSPT , & ! input sigmai , sigma , & !DDsigma input - ISTS, IENS ) ! input + ISTS, IENS, grav ) ! input ! IMPLICIT NONE + real(kind_phys), intent(in) :: grav INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, nctp !! DD, for GFS, pass in ! ! [MODIFY] @@ -3910,10 +3974,11 @@ SUBROUTINE CUMFXR & ! Tracer mass fixe ( IM , IJSDIM, KMAX , NTR , & !DD dimensions GTR , & ! modified GDR , DELP , DELTA , KTMX , IMFXR , & ! input - ISTS , IENS ) ! input + ISTS , IENS, gravi ) ! input ! IMPLICIT NONE + real(kind_phys), intent(in) :: gravi INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in ! ! [MODIFY] @@ -4002,9 +4067,12 @@ SUBROUTINE CUMFXR1 & ! Tracer mass fixer ( IM , IJSDIM, KMAX ,nctp, & !DD dimensions GTR , & ! modified GDR , DELP , DELTA , KTMX , IMFXR , & ! input - ISTS , IENS ) ! input + ISTS , IENS , & ! input + gravi & + ) ! IMPLICIT NONE + real(kind_phys), intent(in) :: gravi INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, nctp !! DD, for GFS, pass in ! diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta index 60b11fdb6..4e2b87dc1 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -448,6 +448,102 @@ type = real kind = kind_phys intent = out +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[rair] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[rvap] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[epsv] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[epsvm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[epsvt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[el] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[emelt] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index 3c108e8eb..7926fc5cc 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -4,7 +4,6 @@ !> This module contains the Grell_Freitas deep convection scheme module cu_gf_deep use machine , only : kind_phys - use physcons, only : qamin real(kind=kind_phys), parameter::g=9.81 real(kind=kind_phys), parameter:: cp=1004. real(kind=kind_phys), parameter:: xlv=2.5e6 @@ -143,7 +142,8 @@ subroutine cu_gf_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,kdt,mc_thresh) ! + ,jmin,kdt,mc_thresh & + ,qamin) implicit none @@ -192,6 +192,7 @@ subroutine cu_gf_deep_run( & ,intent (in ) :: & kpbl !$acc declare copyin(kpbl) + real(kind_phys), intent(in) :: qamin ! ! basic environmental input includes moisture convergence (mconv) ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 index daf63efb1..374009cbd 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 @@ -5,7 +5,6 @@ module cu_gf_driver ! DH* TODO: replace constants with arguments to cu_gf_driver_run - !use physcons , g => con_g, cp => con_cp, xlv => con_hvap, r_v => con_rv use machine , only: kind_phys use cu_gf_deep, only: cu_gf_deep_run,neg_check,fct1d3 use cu_gf_sh , only: cu_gf_sh_run @@ -68,7 +67,8 @@ 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,ten_t,ten_u,ten_v,ten_q,dcliw,dclcw,errmsg,errflg) + do_smoke_transport,kdt,ten_t,ten_u,ten_v,ten_q,dcliw,dclcw, & + qamin,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -165,6 +165,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co !$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 + real(kind_phys), intent(in) :: qamin character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -782,7 +783,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,kdt,mc_thresh) + ,jminm,kdt,mc_thresh & + ,qamin) !$acc kernels do i=its,itf do k=kts,ktf @@ -868,7 +870,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,kdt,mc_thresh) + ,jmin,kdt,mc_thresh & + ,qamin) jpr=0 ipr=0 !$acc kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index beb68a722..ea90a796e 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -725,6 +725,14 @@ type = real kind = kind_phys intent = out +[qamin] + standard_name = minimum_aerosol_concentration + long_name = Minimum aerosol mass mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/SAMF/samfaerosols.F b/physics/CONV/SAMF/samfaerosols.F index ade8f1b5a..8fc5089c6 100644 --- a/physics/CONV/SAMF/samfaerosols.F +++ b/physics/CONV/SAMF/samfaerosols.F @@ -13,10 +13,9 @@ module samfcnv_aerosols subroutine samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kd94, ktcon, fscav, & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, - & qtr, qaero) + & qtr, qaero, g, qamin) use machine , only : kind_phys - use physcons, only : g => con_g, qamin implicit none @@ -35,6 +34,8 @@ subroutine samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, & eta, etad, zi, xlamue, xlamud real(kind=kind_phys), dimension(ix,km), intent(in) :: delp real(kind=kind_phys), dimension(ix,km,ntr+2), intent(in) :: qtr + real(kind=kind_phys), intent(in) :: g + real(kind=kind_phys), intent(in) :: qamin c -- output arguments real(kind=kind_phys), dimension(im,km,ntc), intent(out) :: qaero @@ -412,10 +413,9 @@ end subroutine samfdeepcnv_aerosols subroutine samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, & cnvflg, kb, kmax, kbcon, ktcon, fscav, & xmb, c0t, eta, zi, xlamue, xlamud, delp, - & qtr, qaero) + & qtr, qaero, con_g, qamin) use machine , only : kind_phys - use physcons, only : g => con_g, qamin implicit none @@ -435,6 +435,8 @@ subroutine samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, & eta, zi, xlamue !, xlamud real(kind=kind_phys), dimension(ix,km), intent(in) :: delp real(kind=kind_phys), dimension(ix,km,ntr+2), intent(in) :: qtr + real(kind=kind_phys), intent(in) :: con_g + real(kind=kind_phys), intent(in) :: qamin c -- output arguments real(kind=kind_phys), dimension(im,km,ntc), intent(out) :: qaero @@ -463,9 +465,10 @@ subroutine samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, real(kind=kind_phys), parameter :: zero = 0.0_kind_phys real(kind=kind_phys), parameter :: epsil = 1.e-22_kind_phys ! prevent division by zero real(kind=kind_phys), parameter :: escav = 0.8_kind_phys ! wet scavenging efficiency + real(kind=kind_phys) :: g c -- begin - + g = con_g c -- check if aerosols are present if ( ntc <= 0 .or. itc <= 0 .or. ntr <= 0 ) return if ( ntr < itc + ntc - 3 ) return diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index e122ccc61..c657b1c87 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -59,7 +59,7 @@ subroutine samfshalcnv_run(im,km,nn,itc,ntc,cliq,cp,cvap, & & 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, & - & cat_adj_shal,errmsg,errflg) + & cat_adj_shal,qamin,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -102,6 +102,7 @@ subroutine samfshalcnv_run(im,km,nn,itc,ntc,cliq,cp,cvap, & logical, intent(in) :: hwrf_samfshal,first_time_step, & & restart,progsigma,progomega real(kind_phys), intent(in) :: cat_adj_shal + real(kind=kind_phys), intent(in) :: qamin character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -2127,7 +2128,7 @@ subroutine samfshalcnv_run(im,km,nn,itc,ntc,cliq,cp,cvap, & ! & cnvflg, kb, kmax, ktcon, fscav, !! & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, ! & xmb, c0t, eta, zi, xlamue, xlamud, delp, -! & qtr, qaero) +! & qtr, qaero, grav, qamin) ! endif ! !> ## 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. @@ -2616,4 +2617,3 @@ subroutine samfshalcnv_run(im,km,nn,itc,ntc,cliq,cp,cvap, & end subroutine samfshalcnv_run !> @} end module samfshalcnv - diff --git a/physics/CONV/SAMF/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta index e6ecaf153..60309ab9e 100644 --- a/physics/CONV/SAMF/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -606,6 +606,14 @@ type = real kind = kind_phys intent = in +[qamin] + standard_name = minimum_aerosol_concentration + long_name = Minimum aerosol mass mixing ratio + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/SAS/sascnvn.F b/physics/CONV/SAS/sascnvn.F index 8a78d63ff..7b126d35b 100644 --- a/physics/CONV/SAS/sascnvn.F +++ b/physics/CONV/SAS/sascnvn.F @@ -101,10 +101,6 @@ subroutine sascnvn_run( ! use machine , only : kind_phys use funcphys , only : fpvs -! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & -! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & -! &, cvap => con_cvap, cliq => con_cliq & -! &, eps => con_eps, epsm1 => con_epsm1,rgas => con_rd implicit none ! ! Interface variables diff --git a/physics/CONV/SAS/shalcnv.F b/physics/CONV/SAS/shalcnv.F index 872b6d694..a9c278700 100644 --- a/physics/CONV/SAS/shalcnv.F +++ b/physics/CONV/SAS/shalcnv.F @@ -96,10 +96,6 @@ subroutine shalcnv_run( & ! use machine , only : kind_phys use funcphys , only : fpvs -! use physcons, grav => con_g, cp => con_cp, hvap => con_hvap & -! &, rv => con_rv, fv => con_fvirt, t0c => con_t0c & -! &, rd => con_rd, cvap => con_cvap, cliq => con_cliq & -! &, eps => con_eps, epsm1 => con_epsm1 implicit none ! ! Interface variables diff --git a/physics/CONV/nTiedtke/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 index cd73aaf10..3a1669622 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke.F90 @@ -13,8 +13,6 @@ module cu_ntiedtke ! DH* TODO - replace with arguments to subroutine calls, ! this also requires redefining derived constants in the ! parameter section below - use physcons, only:rd=>con_rd, rv=>con_rv, g=>con_g, & - & cpd=>con_cp, alv=>con_hvap, alf=>con_hfus implicit none real(kind=kind_phys),private :: rcpd,vtmpc1,als, & @@ -34,19 +32,15 @@ module cu_ntiedtke real(kind=kind_phys),parameter:: rtber = tmelt-5. real(kind=kind_phys),parameter:: rtice = tmelt-23. parameter( & - rcpd=1.0/cpd, & - zrg=1.0/g, & - c2es=c1es*rd/rv, & - als = alv+alf, & c5les=c3les*(tmelt-c4les), & - c5ies=c3ies*(tmelt-c4ies), & - r5alvcp=c5les*alv*rcpd, & - r5alscp=c5ies*als*rcpd, & - ralvdcp=alv*rcpd, & - ralsdcp=als*rcpd, & - ralfdcp=alf*rcpd, & - vtmpc1=rv/rd-1.0, & - rovcp = rd*rcpd ) + c5ies=c3ies*(tmelt-c4ies)) + + real(kind=kind_phys) :: rd = 1.0E30_kind_phys + real(kind=kind_phys) :: rv = 1.0E30_kind_phys + real(kind=kind_phys) :: g = 1.0E30_kind_phys + real(kind=kind_phys) :: cpd = 1.0E30_kind_phys + real(kind=kind_phys) :: alv = 1.0E30_kind_phys + real(kind=kind_phys) :: alf = 1.0E30_kind_phys ! momtrans: momentum transport method ( 1 = IFS40r1 method; 2 = new method ) ! ------- @@ -121,12 +115,16 @@ module cu_ntiedtke !! \htmlinclude cu_ntiedtke_init.html !! subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & - imfdeepcnv_ntiedtke,mpirank, mpiroot, errmsg, errflg) + imfdeepcnv_ntiedtke, con_rd, con_rv, & + con_g, con_cp, con_hvap, con_hfus, & + mpirank, mpiroot, errmsg, errflg) implicit none integer, intent(in) :: imfshalcnv, imfshalcnv_ntiedtke integer, intent(in) :: imfdeepcnv, imfdeepcnv_ntiedtke + real(kind=kind_phys), intent(in) :: con_rd, con_rv, con_g + real(kind=kind_phys), intent(in) :: con_cp, con_hvap, con_hfus integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -136,6 +134,26 @@ subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & errmsg = '' errflg = 0 + ! initialize variables using constants + rd = con_rd + rv = con_rv + g = con_g + cpd = con_cp + alv = con_hvap + alf = con_hfus + + rcpd=1.0/cpd + zrg=1.0/g + c2es=c1es*rd/rv + als = alv+alf + r5alvcp=c5les*alv*rcpd + r5alscp=c5ies*als*rcpd + ralvdcp=alv*rcpd + ralsdcp=als*rcpd + ralfdcp=alf*rcpd + vtmpc1=rv/rd-1.0 + rovcp = rd*rcpd + ! DH* temporary if (mpirank==mpiroot) then write(0,*) ' -----------------------------------------------------------------------------------------------------------------------------' @@ -4109,4 +4127,3 @@ end function foeldcpm !================================================================================================================= end module cu_ntiedtke !================================================================================================================= - diff --git a/physics/CONV/nTiedtke/cu_ntiedtke.meta b/physics/CONV/nTiedtke/cu_ntiedtke.meta index 3348a4d65..82d9586aa 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -35,6 +35,54 @@ dimensions = () type = integer intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in [mpirank] standard_name = mpi_rank long_name = current MPI-rank diff --git a/physics/GWD/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 index 862271fad..bef43f533 100644 --- a/physics/GWD/cires_ugwp.F90 +++ b/physics/GWD/cires_ugwp.F90 @@ -20,6 +20,7 @@ module cires_ugwp use ugwp_driver_v0 use gwdps, only: gwdps_run use cires_ugwp_triggers + use ugwp_common_v0, only: ugwp_common_v0_init implicit none @@ -40,7 +41,8 @@ module cires_ugwp !! subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, levs, ak, bk, dtp, cdmbgwd, cgwf, & - pa_rf_in, tau_rf_in, con_p0, gwd_opt,do_ugwp, errmsg, errflg) + pa_rf_in, tau_rf_in, con_p0, con_pi, con_rerth, con_g, con_cp, & + con_rd, con_rv, con_fvirt, gwd_opt, do_ugwp, errmsg, errflg) !---- initialization of cires_ugwp implicit none @@ -56,7 +58,8 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in - real(kind=kind_phys), intent (in) :: con_p0 + real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth, con_g + real(kind=kind_phys), intent (in) :: con_cp, con_rd, con_rv, con_fvirt integer, intent(in) :: gwd_opt logical, intent (in) :: do_ugwp @@ -72,6 +75,9 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if (is_initialized) return + call ugwp_common_v0_init(con_pi, con_rerth, con_g, con_cp, con_rd, & + con_rv, con_fvirt) + ! Consistency checks if (gwd_opt/=1) then write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & diff --git a/physics/GWD/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta index 788a4fa27..bc2a74eff 100644 --- a/physics/GWD/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -131,6 +131,62 @@ type = real kind = kind_phys intent = in +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rerth] + standard_name = radius_of_earth + long_name = radius of earth + units = m + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [gwd_opt] standard_name = control_for_drag_suite_gravity_wave_drag long_name = flag to choose gwd scheme diff --git a/physics/GWD/cires_ugwp_initialize.F90 b/physics/GWD/cires_ugwp_initialize.F90 index ae923671d..aa0bb7cc3 100644 --- a/physics/GWD/cires_ugwp_initialize.F90 +++ b/physics/GWD/cires_ugwp_initialize.F90 @@ -1,31 +1,61 @@ !>\file cires_ugwp_initialize.F90 !! This file contains cu-cires ugwp initialization scheme. -! initialization of ugwp_common_v0 ! init gw-solvers (1,2) .. no UFS-funds for (3,4) tests ! init gw-source specifications ! init gw-background dissipation !=============================== -!> This module contains UGWP v0 initialization schemes - module ugwp_common_v0 -! - use machine, only: kind_phys - use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & - rv => con_rv, cpd => con_cp, fv => con_fvirt,& - arad => con_rerth - implicit none +!> Shared constants used by the UGWP v0 implementation. +!! Values are supplied by the CCPP host during scheme initialization. +module ugwp_common_v0 + + use machine, only: kind_phys + + implicit none + + real(kind=kind_phys) :: pi, grav, rd, rv, cpd, fv, arad + real(kind=kind_phys) :: grcp, rgrav, rdi, gor, gr2, gocp + real(kind=kind_phys) :: rcpd, rcpd2, pi2, omega1, omega2 + real(kind=kind_phys) :: rad_to_deg, deg_to_rad + real(kind=kind_phys) :: dw2min, bnv2min, velmin + +contains - real(kind=kind_phys), parameter :: grcp = grav/cpd, rgrav = 1.0d0/grav, & - rdi = 1.0d0/rd, & - gor = grav/rd, gr2 = grav*gor, gocp = grav/cpd, & - rcpd = 1./cpd, rcpd2 = 0.5*rcpd, & - pi2 = pi + pi, omega1 = pi2/86400.0, & - omega2 = omega1+omega1, & - rad_to_deg=180.0/pi, deg_to_rad=pi/180.0, & - dw2min=1.0, bnv2min=1.e-6, velmin=sqrt(dw2min) + subroutine ugwp_common_v0_init(con_pi, con_rerth, con_g, con_cp, con_rd, & + con_rv, con_fvirt) + real(kind=kind_phys), intent(in) :: con_pi, con_rerth, con_g, con_cp + real(kind=kind_phys), intent(in) :: con_rd, con_rv, con_fvirt + + pi = con_pi + arad = con_rerth + grav = con_g + cpd = con_cp + rd = con_rd + rv = con_rv + fv = con_fvirt + + grcp = grav/cpd + rgrav = 1.0_kind_phys/grav + rdi = 1.0_kind_phys/rd + gor = grav/rd + gr2 = grav*gor + gocp = grav/cpd + rcpd = 1.0_kind_phys/cpd + rcpd2 = 0.5_kind_phys*rcpd + pi2 = pi + pi + omega1 = pi2/86400.0_kind_phys + omega2 = omega1 + omega1 + rad_to_deg = 180.0_kind_phys/pi + deg_to_rad = pi/180.0_kind_phys + dw2min = 1.0_kind_phys + bnv2min = 1.0e-6_kind_phys + velmin = sqrt(dw2min) + + end subroutine ugwp_common_v0_init + +end module ugwp_common_v0 - end module ugwp_common_v0 ! ! !=================================================== @@ -98,7 +128,7 @@ end subroutine init_global_gwdis_v0 !> This module contains orographic wave source schemes for UGWP v0. module ugwpv0_oro_init - use ugwp_common_v0, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + use ugwp_common_v0, only : bnv2min, grav, grcp, fv, cpd, pi implicit none ! @@ -143,7 +173,7 @@ module ugwpv0_oro_init integer :: nstoro ! flag for stochastic launch above SG-peak integer, parameter :: mdir = 8 - real, parameter :: fdir=.5*mdir/pi + real :: fdir = 1.0E30 integer nwdir(mdir) data nwdir/6,7,5,8,2,3,1,4/ @@ -168,8 +198,8 @@ module ugwpv0_oro_init real, parameter :: lzmax = 18.e3 ! 18 km real, parameter :: mkzmin = 6.28/lzmax real, parameter :: mkz2min = mkzmin*mkzmin - real, parameter :: zbr_pi = (3.0/2.0)*pi - real, parameter :: zbr_ifs = 0.5*pi + real :: zbr_pi = 1.0E30 + real :: zbr_ifs = 1.0E30 contains ! @@ -192,6 +222,9 @@ subroutine init_oro_gws_v0(nwaves, nazdir, nstoch, effac, & real, parameter :: lonr_refgw = 192.0 ! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch + fdir=.5*mdir/pi + zbr_pi = (3.0/2.0)*pi + zbr_ifs = 0.5*pi nworo = nwaves nazoro = nazdir @@ -307,7 +340,9 @@ module ugwpv0_wmsdis_init real , parameter :: zcimin = ucrit2 real , parameter :: zcimax = 125.0 real , parameter :: zgam = 0.25 - real , parameter :: zms_l = 2000.0, zms = pi2 / zms_l, zmsi = 1.0 / zms + real , parameter :: zms_l = 2000.0 + real :: zms = 1.0E30 + real :: zmsi = 1.0E30 integer :: ilaunch real :: gw_eff @@ -340,6 +375,9 @@ subroutine initsolv_wmsdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_phy real :: zang, zang1, znorm real :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp + zms = pi2 / zms_l + zmsi = 1.0 / zms + if( nwaves == 0) then ! ! redefine from the deafault diff --git a/physics/GWD/ugwp_driver_v0.F90 b/physics/GWD/ugwp_driver_v0.F90 index e6e824e79..3880587a8 100644 --- a/physics/GWD/ugwp_driver_v0.F90 +++ b/physics/GWD/ugwp_driver_v0.F90 @@ -1033,9 +1033,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, & ! real :: rcpd, grav2cpd - real, parameter :: rcpdl = cpd/grav, & ! 1/[g/cp] == cp/g - grav2cpd = grav/rcpdl, & ! g*(g/cp)= g^2/cp - cpdi = one/cpd + real :: rcpdl, grav2cpd, cpdi real :: expdis, fdis ! real :: fmode, expdis, fdis @@ -1045,6 +1043,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, & ! !-------------------------------------------------------------------------- ! + rcpdl = cpd/grav ! 1/[g/cp] == cp/g + grav2cpd = grav/rcpdl ! g*(g/cp) == g^2/cp + cpdi = one/cpd + do k=1,klev do j=1,klon pdvdt(j,k) = zero diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index c6922bd8d..ab45ad142 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -64,7 +64,8 @@ module unified_ugwp !! subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, levs, ak, bk, dtp, cdmbgwd, cgwf, & - con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & + con_pi, con_rerth, con_g, con_cp, con_rd, con_rv, con_fvirt, & + pa_rf_in, tau_rf_in, con_p0, do_ugwp, & do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, & errmsg, errflg) @@ -84,7 +85,8 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in - real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth + real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth, con_g + real(kind=kind_phys), intent (in) :: con_cp, con_rd, con_rv, con_fvirt logical, intent (in) :: do_ugwp logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, & diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index c966be869..4ceba71ef 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -131,6 +131,46 @@ type = real kind = kind_phys intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [pa_rf_in] standard_name = air_pressure_at_bottom_extent_of_rayleigh_damping long_name = pressure level from which Rayleigh Damping is applied 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 b013ce8d1..26a598c51 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 @@ -18,7 +18,8 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & 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,& + progsigma, con_g, con_eps, con_epsm1, con_epsq, con_fvirt, con_rog, 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, & @@ -51,7 +52,8 @@ subroutine GFS_MP_generic_post_run( 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), intent(in) :: dtf, frain, con_g, con_eps, con_epsm1, con_epsq + real(kind=kind_phys), intent(in) :: con_fvirt, con_rog, 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 @@ -364,6 +366,8 @@ subroutine GFS_MP_generic_post_run( rann, xlat, xlon, gt0, & gq0(:,:,1), prsl, prsi, & rain, phii, tsfc, & ! input + con_g, con_eps, con_epsm1, & ! input + con_epsq, con_fvirt, con_rog, & ! input domr, domzr, domip, doms) ! output ! ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation 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 8aecfb2d9..a43dc9241 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta @@ -164,6 +164,46 @@ type = real kind = kind_phys intent = in +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rog] + standard_name = ratio_of_gas_constant_dry_air_to_gravitational_acceleration + long_name = (rd/g) + units = J s2 K-1 kg-1 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in [rhowater] standard_name = fresh_liquid_water_density_at_0c long_name = density of liquid water @@ -1042,4 +1082,3 @@ dimensions = () type = integer intent = out - diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index bfb5df33d..0e3262035 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmg_pre type = scheme dependencies_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F dependencies = MP/TEMPO/tempo_v3/src/module_mp_tempo_params.F90 dependencies = MP/TEMPO/tempo_v3/src/module_mp_tempo_cfgs.F90 dependencies = MP/TEMPO/tempo_v3/src/module_mp_tempo_ml.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index b627633d5..fa9bdaa18 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -44,7 +44,8 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & lcnorm, imp_physics, lnoprec, idate, iflip, do_RRTMGP, & mpicomm, mpirank, mpiroot, lalw1bd, & iaermdl, iaerflg, aeros_file, con_pi, con_t0c, con_c, con_boltz, & - con_plnk, con_solr_2008, con_solr_2002, con_g, con_rd, co2usr_file, & + con_plnk, con_solr_2008, con_solr_2002, con_g, con_cp, con_rd, & + co2usr_file, & co2cyc_file, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, isubclw,& iswmode, ipsd0, ltp, lextop, errmsg, errflg) ! ================= subprogram documentation block ================ ! @@ -167,7 +168,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & character(len=26),intent(in) :: aeros_file, solar_file, co2usr_file,& co2cyc_file real(kind_phys), intent(in) :: con_pi, con_t0c, con_c, con_boltz, & - con_plnk, con_solr_2008, con_solr_2002, con_g, con_rd + con_plnk, con_solr_2008, con_solr_2002, con_g, con_cp, con_rd integer, intent(inout) :: ipsd0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -229,12 +230,12 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & call rlwinit ( mpirank, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & - iovr_exp, iovr_exprand, errflg, errmsg ) + iovr_exp, iovr_exprand, con_g, con_cp, errflg, errmsg ) if(errflg/=0) return call rswinit ( mpirank, rad_hr_units, inc_minor_gas, icliq_sw, isubclw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & - iovr_exp, iovr_exprand,iswmode, errflg, errmsg ) + iovr_exp, iovr_exprand, iswmode, con_g, con_cp, errflg, errmsg ) if(errflg/=0) return if ( mpirank == mpiroot ) then diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index 47c1e1279..ec6d903b4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -357,6 +357,14 @@ type = real kind = kind_phys intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in [lalw1bd] standard_name = do_longwave_aerosol_band_properties long_name = control of band or multiband longwave aerosol properties diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta index b4b50906e..07c85805b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_pre type = scheme dependencies_path = ../../ - dependencies = hooks/physcons.F90,tools/funcphys.f90,hooks/machine.F,Radiation/RRTMG/iounitdef.f,Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/RRTMG/iounitdef.f,Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 dependencies = Radiation/RRTMG/iounitdef.f,Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## 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 8683fde8a..620a10147 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 @@ -21,10 +21,16 @@ module GFS_time_vary_pre !> \section arg_table_GFS_time_vary_pre_init Argument Table !! \htmlinclude GFS_time_vary_pre_init.html !! - subroutine GFS_time_vary_pre_init (errmsg, errflg) + subroutine GFS_time_vary_pre_init (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp, errmsg, errflg) + + use machine, only: kind_phys implicit none + real(kind=kind_phys), intent(in) :: con_rd, con_rv, con_cp + real(kind=kind_phys), intent(in) :: con_cvap, con_cliq, con_csol + real(kind=kind_phys), intent(in) :: con_hvap, con_hfus, con_psat, con_ttp character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -35,7 +41,8 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) if (is_initialized) return !--- Call gfuncphys (funcphys.f) to compute all physics function tables. - call gfuncphys () + call gfuncphys (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp) is_initialized = .true. 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 da1d7ec81..61f2a07eb 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 @@ -2,12 +2,92 @@ name = GFS_time_vary_pre type = scheme dependencies_path = ../../ - dependencies = hooks/physcons.F90,tools/funcphys.f90,hooks/machine.F + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] name = GFS_time_vary_pre_init type = scheme +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_psat] + standard_name = saturation_pressure_at_triple_point_of_water + long_name = saturation pressure at triple point of water + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + 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_time_vary_pre.neptune.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 index 80ae601aa..d586c3c41 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 @@ -21,10 +21,16 @@ module GFS_time_vary_pre !> \section arg_table_GFS_time_vary_pre_init Argument Table !! \htmlinclude GFS_time_vary_pre_init.html !! - subroutine GFS_time_vary_pre_init (errmsg, errflg) + subroutine GFS_time_vary_pre_init (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp, errmsg, errflg) + + use machine, only: kind_phys implicit none + real(kind=kind_phys), intent(in) :: con_rd, con_rv, con_cp + real(kind=kind_phys), intent(in) :: con_cvap, con_cliq, con_csol + real(kind=kind_phys), intent(in) :: con_hvap, con_hfus, con_psat, con_ttp character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -35,7 +41,8 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) if (is_initialized) return !--- Call gfuncphys (funcphys.f) to compute all physics function tables. - call gfuncphys () + call gfuncphys (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp) is_initialized = .true. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta index bb2e8c35a..2306b3899 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta @@ -2,12 +2,92 @@ name = GFS_time_vary_pre type = scheme dependencies_path = ../../ - dependencies = hooks/physcons.F90,tools/funcphys.f90,hooks/machine.F + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] name = GFS_time_vary_pre_init type = scheme +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_psat] + standard_name = saturation_pressure_at_triple_point_of_water + long_name = saturation pressure at triple point of water + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -73,14 +153,14 @@ [nsswr] standard_name = number_of_timesteps_between_shortwave_radiation_calls long_name = number of timesteps between shortwave radiation calls - units = + units = count dimensions = () type = integer intent = in [nslwr] standard_name = number_of_timesteps_between_longwave_radiation_calls long_name = number of timesteps between longwave radiation calls - units = + units = count dimensions = () type = integer intent = in 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 fa7f2b91c..ba494638e 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 @@ -18,10 +18,16 @@ module GFS_time_vary_pre !> \section arg_table_GFS_time_vary_pre_init Argument Table !! \htmlinclude GFS_time_vary_pre_init.html !! - subroutine GFS_time_vary_pre_init (errmsg, errflg) + subroutine GFS_time_vary_pre_init (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp, errmsg, errflg) + + use machine, only: kind_phys implicit none + real(kind=kind_phys), intent(in) :: con_rd, con_rv, con_cp + real(kind=kind_phys), intent(in) :: con_cvap, con_cliq, con_csol + real(kind=kind_phys), intent(in) :: con_hvap, con_hfus, con_psat, con_ttp character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -32,7 +38,8 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) if (is_initialized) return !--- Call gfuncphys (funcphys.f) to compute all physics function tables. - call gfuncphys () + call gfuncphys (con_rd, con_rv, con_cp, con_cvap, con_cliq, con_csol, & + con_hvap, con_hfus, con_psat, con_ttp) is_initialized = .true. 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 155e37367..7667b0b60 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 @@ -2,12 +2,92 @@ name = GFS_time_vary_pre type = scheme dependencies_path = ../../ - dependencies = hooks/physcons.F90,tools/funcphys.f90,hooks/machine.F + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] name = GFS_time_vary_pre_init type = scheme +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_psat] + standard_name = saturation_pressure_at_triple_point_of_water + long_name = saturation pressure at triple point of water + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + 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/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index 0eee41989..4e80ef7ee 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -2,8 +2,8 @@ name = sgscloud_radpre type = scheme dependencies_path = ../../ - dependencies = hooks/physcons.F90,tools/funcphys.f90,hooks/machine.F - dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 + dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = Radiation/RRTMG/radcons.f90 dependencies = Radiation/radiation_clouds.f,MP/module_mp_radar.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## diff --git a/physics/MP/GFDL/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 index aec844001..d38b7610a 100644 --- a/physics/MP/GFDL/fv_sat_adj.F90 +++ b/physics/MP/GFDL/fv_sat_adj.F90 @@ -52,15 +52,7 @@ module fv_sat_adj ! rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs ! ! - ! DH* TODO - MAKE THIS INPUT ARGUMENTS *DH - use physcons, only : rdgas => con_rd_dyn, & - rvgas => con_rv_dyn, & - grav => con_g_dyn, & - hlv => con_hvap_dyn, & - hlf => con_hfus_dyn, & - cp_air => con_cp_dyn - ! *DH - use machine, only: kind_grid, kind_dyn + use machine, only: kind_grid, kind_dyn, kind_phys use module_gfdlmp_param, only: ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt use module_gfdlmp_param, only: icloud_f, sat_adj0, t_sub, cld_min use module_gfdlmp_param, only: tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r @@ -81,11 +73,15 @@ module fv_sat_adj logical :: is_initialized = .false. - real(kind=kind_dyn), parameter :: rrg = -rdgas/grav - ! real, parameter :: cp_air = cp_air ! 1004.6, heat capacity of dry air at constant pressure, come from constants_mod - real(kind=kind_dyn), parameter :: cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapor at constant pressure - real(kind=kind_dyn), parameter :: cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume - real(kind=kind_dyn), parameter :: cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume + real(kind=kind_dyn) :: rrg = 1.0E30_kind_dyn + real(kind=kind_dyn) :: cp_vap = 1.0E30_kind_dyn + real(kind=kind_dyn) :: cv_air = 1.0E30_kind_dyn + real(kind=kind_dyn) :: cv_vap = 1.0E30_kind_dyn + real(kind=kind_dyn) :: rvgas = 1.0E30_kind_dyn + real(kind=kind_dyn) :: grav = 1.0E30_kind_dyn + real(kind=kind_dyn) :: hlv = 1.0E30_kind_dyn + real(kind=kind_dyn) :: cp_air = 1.0E30_kind_dyn + real(kind=kind_dyn) :: rdgas = 1.0E30_kind_dyn ! http: / / www.engineeringtoolbox.com / ice - thermal - properties - d_576.html ! c_ice = 2050.0 at 0 deg c ! c_ice = 1972.0 at - 15 deg c @@ -98,19 +94,19 @@ module fv_sat_adj ! real, parameter :: c_liq = 4218.0 ! ifs: heat capacity of liquid at 0 deg c real(kind=kind_dyn), parameter :: c_ice = 1972.0 !< gfdl: heat capacity of ice at - 15 deg c real(kind=kind_dyn), parameter :: c_liq = 4185.5 !< gfdl: heat capacity of liquid at 15 deg c - real(kind=kind_dyn), parameter :: dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling + real(kind=kind_dyn) :: dc_vap = 1.0E30_kind_dyn real(kind=kind_dyn), parameter :: dc_ice = c_liq - c_ice !< 2213.5, isobaric heating / colling real(kind=kind_dyn), parameter :: tice = 273.16 !< freezing temperature real(kind=kind_dyn), parameter :: t_wfr = tice - 40. !< homogeneous freezing temperature - real(kind=kind_dyn), parameter :: lv0 = hlv - dc_vap * tice !< 3.13905782e6, evaporation latent heat coefficient at 0 deg k - real(kind=kind_dyn), parameter :: li00 = hlf - dc_ice * tice !< - 2.7105966e5, fusion latent heat coefficient at 0 deg k + real(kind=kind_dyn) :: lv0 = 1.0E30_kind_dyn + real(kind=kind_dyn) :: li00 = 1.0E30_kind_dyn ! real (kind_grid), parameter :: e00 = 610.71 ! gfdl: saturation vapor pressure at 0 deg c real (kind_grid), parameter :: e00 = 611.21 !< ifs: saturation vapor pressure at 0 deg c - real (kind_grid), parameter :: d2ice = dc_vap + dc_ice !< - 126, isobaric heating / cooling - real (kind_grid), parameter :: li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k - real(kind=kind_dyn), parameter :: lat2 = (hlv + hlf) ** 2 !< used in bigg mechanism - real(kind=kind_dyn) :: d0_vap !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap - real(kind=kind_dyn) :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap + real (kind_grid) :: d2ice = 1.0E30_kind_grid + real (kind_grid) :: li2 = 1.0E30_kind_grid + real(kind=kind_dyn) :: lat2 = 1.0E30_kind_dyn + real(kind=kind_dyn) :: d0_vap = 1.0E30_kind_dyn !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap + real(kind=kind_dyn) :: lv00 = 1.0E30_kind_dyn !< the same as lv0, except that cp_vap can be cp_vap or cv_vap real(kind=kind_dyn), allocatable :: table (:), table2 (:), tablew (:), des2 (:), desw (:) contains @@ -120,7 +116,9 @@ module fv_sat_adj !! \htmlinclude fv_sat_adj_init.html !! subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & - mpirank, mpiroot, errmsg, errflg) + mpirank, mpiroot, con_rd, con_cp, & + con_g, con_hvap, con_hfus, con_rv, & + errmsg, errflg) implicit none @@ -133,13 +131,44 @@ subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & real(kind_dyn), intent(in ) :: cpilist(0:ngas) integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot + real(kind_phys), intent(in ) :: con_rd + real(kind_phys), intent(in ) :: con_cp + real(kind_phys), intent(in ) :: con_g + real(kind_phys), intent(in ) :: con_hvap + real(kind_phys), intent(in ) :: con_hfus + real(kind_phys), intent(in ) :: con_rv character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg ! Local variables integer, parameter :: length = 2621 + real(kind_dyn) :: con_rd_dyn + real(kind_dyn) :: con_cp_dyn + real(kind_dyn) :: hlf integer :: i + con_rd_dyn = real(con_rd, kind=kind_dyn) + con_cp_dyn = real(con_cp, kind=kind_dyn) + rdgas = con_rd_dyn + rvgas = real(con_rv, kind=kind_dyn) + grav = real(con_g, kind=kind_dyn) + hlv = real(con_hvap, kind=kind_dyn) + hlf = real(con_hfus, kind=kind_dyn) + + ! initialize module variables + rrg = -rdgas/grav + cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapor at constant pressure + ! real, parameter :: cp_air = cp_air ! 1004.6, heat capacity of dry air at constant pressure, come from constants_mod + cp_air = real(con_cp, kind=kind_dyn) + cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume + cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume + dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling + lv0 = hlv - dc_vap * tice !< 3.13905782e6, evaporation latent heat coefficient at 0 deg k + li00 = hlf - dc_ice * tice !< - 2.7105966e5, fusion latent heat coefficient at 0 deg k + d2ice = dc_vap + dc_ice !< - 126, isobaric heating / cooling + li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k + lat2 = (hlv + hlf) ** 2 !< used in bigg mechanism + ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -179,7 +208,8 @@ subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & desw (length) = desw (length - 1) #ifdef MULTI_GASES - call multi_gases_init(ngas,nwat,rilist,cpilist,mpirank==mpiroot) + call multi_gases_init(ngas,nwat,rilist,cpilist,con_rd_dyn,con_cp_dyn,& + mpirank==mpiroot) #endif is_initialized = .true. @@ -236,7 +266,6 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, isc1, iec1, isc2, iec2, k qs, qg, hs, peln, delz, delp, pt, pkz, q_con, akap, cappa, area, dtdt, & out_dt, last_step, do_qa, qa, & nthreads, errmsg, errflg) - implicit none ! Interface variables diff --git a/physics/MP/GFDL/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta index 5fc79663e..442a97519 100644 --- a/physics/MP/GFDL/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../hooks/machine.F dependencies = ../multi_gases.F90,../module_mp_radar.F90 dependencies = module_gfdlmp_param.F90 @@ -67,6 +67,54 @@ dimensions = () type = integer intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in [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 f0a341330..cf052734f 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 @@ -3,6 +3,7 @@ !! \cite chen_and_lin_2013 ). module gfdl_cloud_microphys_v3 + use machine, only: kind_phys use gfdl_cloud_microphys_v3_mod, only: gfdl_cloud_microphys_v3_mod_init, & gfdl_cloud_microphys_v3_mod_driver, & gfdl_cloud_microphys_v3_mod_end, & @@ -31,7 +32,16 @@ module gfdl_cloud_microphys_v3 subroutine gfdl_cloud_microphys_v3_init (me, master, nlunit, input_nml_file, logunit, & fn_nml, imp_physics, imp_physics_gfdl, do_shoc, & - hydrostatic, errmsg, errflg) + hydrostatic, con_g, con_1ovg, & + con_pi, con_boltz, con_avgd, con_rd, & + con_rv, con_fvirt, con_runiver, con_cp, & + con_csol, con_hvap, con_hfus, con_rhoair_IFS, & + con_rhosnow, con_one, con_amd, con_amw, & + con_visd, con_visk, con_vdifu, con_tcond, & + con_cdg, con_cdh, con_rhocw, con_rhoci, & + con_rhocr, con_rhocg, con_rhoch, con_qcmin, & + con_qfmin, errmsg, errflg) + implicit none @@ -45,6 +55,37 @@ subroutine gfdl_cloud_microphys_v3_init (me, master, nlunit, input_nml_file, log integer, intent( in) :: imp_physics_gfdl logical, intent( in) :: do_shoc logical, intent( in) :: hydrostatic + real(kind_phys), intent(in) :: con_g + real(kind_phys), intent(in) :: con_1ovg + real(kind_phys), intent(in) :: con_pi + real(kind_phys), intent(in) :: con_boltz + real(kind_phys), intent(in) :: con_avgd + real(kind_phys), intent(in) :: con_rd + real(kind_phys), intent(in) :: con_rv + real(kind_phys), intent(in) :: con_fvirt + real(kind_phys), intent(in) :: con_runiver + real(kind_phys), intent(in) :: con_cp + real(kind_phys), intent(in) :: con_csol + real(kind_phys), intent(in) :: con_hvap + real(kind_phys), intent(in) :: con_hfus + real(kind_phys), intent(in) :: con_rhoair_IFS + real(kind_phys), intent(in) :: con_rhosnow + real(kind_phys), intent(in) :: con_one + real(kind_phys), intent(in) :: con_amd + real(kind_phys), intent(in) :: con_amw + real(kind_phys), intent(in) :: con_visd + real(kind_phys), intent(in) :: con_visk + real(kind_phys), intent(in) :: con_vdifu + real(kind_phys), intent(in) :: con_tcond + real(kind_phys), intent(in) :: con_cdg + real(kind_phys), intent(in) :: con_cdh + real(kind_phys), intent(in) :: con_rhocw + real(kind_phys), intent(in) :: con_rhoci + real(kind_phys), intent(in) :: con_rhocr + real(kind_phys), intent(in) :: con_rhocg + real(kind_phys), intent(in) :: con_rhoch + real(kind_phys), intent(in) :: con_qcmin + real(kind_phys), intent(in) :: con_qfmin character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -66,7 +107,16 @@ subroutine gfdl_cloud_microphys_v3_init (me, master, nlunit, input_nml_file, log return endif - call gfdl_cloud_microphys_v3_mod_init(me, master, nlunit, input_nml_file, logunit, fn_nml, hydrostatic, errmsg, errflg) + call gfdl_cloud_microphys_v3_mod_init(me, master, nlunit, input_nml_file, logunit, & + fn_nml, hydrostatic, con_g, con_1ovg, & + con_pi, con_boltz, con_avgd, con_rd, & + con_rv, con_fvirt, con_runiver, con_cp, & + con_csol, con_hvap, con_hfus, con_rhoair_IFS, & + con_rhosnow, con_one, con_amd, con_amw, & + con_visd, con_visk, con_vdifu, con_tcond, & + con_cdg, con_cdh, con_rhocw, con_rhoci, & + con_rhocr, con_rhocg, con_rhoch, con_qcmin, & + con_qfmin, errmsg, errflg) is_initialized = .true. 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 17c6f9850..843c20bdf 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta @@ -2,7 +2,6 @@ name = gfdl_cloud_microphys_v3 type = scheme dependencies = ../../../hooks/machine.F - dependencies = ../../../hooks/physcons.F90 dependencies = gfdl_cloud_microphys_v3_mod.F90 ######################################################################## @@ -81,6 +80,254 @@ dimensions = () type = logical intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_boltz] + standard_name = boltzmann_constant + long_name = Boltzmann constant + units = J K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_avgd] + standard_name = avogadro_constant + long_name = Avogadro constant + units = mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_runiver] + standard_name = molar_gas_constant + long_name = universal ideal molar gas constant + units = J K-1 mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + intent = in + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhoair_IFS] + standard_name = density_of_air_IFS + long_name = density of air IFS + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhosnow] + standard_name = density_of_snow + long_name = density of snow + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_one] + standard_name = constant_one + long_name = mathematical constant of one + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amd] + standard_name = molecular_weight_of_dry_air + long_name = molecular weight of dry air + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amw] + standard_name = molecular_weight_of_water_vapor + long_name = molecular weight of water vapor + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_visd] + standard_name = dynamic_viscosity_of_air + long_name = dynamic viscosity of air at 0 deg C and 1000 hPa (Mason, 1971) + units = kg m-1 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_visk] + standard_name = kinematic_viscosity_of_air + long_name = kinematic viscosity of air at 0 deg C and 1000 hPa (Mason, 1971) + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_vdifu] + standard_name = diffusivity_of_water_vapor_in_air + long_name = diffusivity of water vapor in air at 0 deg C and 1000 hPa (Mason, 1971) + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_tcond] + standard_name = thermal_conductivity_of_air + long_name = thermal conductivity of air at 0 deg C and 1000 hPa (Mason, 1971) + units = W m-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cdg] + standard_name = drag_coefficient_of_graupel + long_name = drag coefficient of graupel (Locatelli and Hobbs, 1974) + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cdh] + standard_name = drag_coefficient_of_hail + long_name = drag coefficient of hail (Heymsfield and Wright, 2014) + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhocw] + standard_name = density_of_cloud_water + long_name = density of cloud water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhoci] + standard_name = density_of_cloud_ice + long_name = density of cloud ice + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhocr] + standard_name = density_of_rain + long_name = density of rain (Lin et al., 1983) + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhocg] + standard_name = density_of_graupel + long_name = density of graupel (Rutledge and Hobbs, 1984) + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rhoch] + standard_name = density_of_hail + long_name = density of hail (Lin et al., 1983) + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_qcmin] + standard_name = minimum_mass_mixing_ratio_of_cloud_condensate + long_name = minimum value for cloud condensates + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_qfmin] + standard_name = minimum_mass_mixing_ratio_for_sedimentation + long_name = minimum value for sedimentation + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in [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_mod.F90 b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 index 55aaa9e0a..67a01b686 100644 --- a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 @@ -59,31 +59,6 @@ module gfdl_cloud_microphys_v3_mod ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub, qi_gen, tice - use physcons, only: grav => con_g, & - rgrav => con_1ovg, & - pi => con_pi, & - boltzmann => con_boltz, & - avogadro => con_sbc, & - rdgas => con_rd, & - rvgas => con_rv, & - zvir => con_fvirt, & - runiver => con_runiver, & - cp_air => con_cp, & - c_ice => con_csol, & - !c_liq => con_cliq, & - !e00 => con_psat, & - hlv => con_hvap, & - hlf => con_hfus, & - rho0 => rhoair_IFS, & - rhos => rhosnow, & - one_r8 => con_one, & - con_amd, con_amw, visd, & - visk, vdifu, tcond, cdg, & - cdh, rhow => rhocw, & - rhoi => rhoci, & - rhor => rhocr, & - rhog => rhocg, & - rhoh => rhoch, qcmin, qfmin private ! ----------------------------------------------------------------------- @@ -137,6 +112,39 @@ module gfdl_cloud_microphys_v3_mod logical :: tables_are_initialized = .false. ! initialize satuation tables + real(kind_phys) :: grav = 1.0E30 + real(kind_phys) :: rgrav = 1.0E30 + real(kind_phys) :: pi = 1.0E30 + real(kind_phys) :: boltzmann = 1.0E30 + real(kind_phys) :: avogadro = 1.0E30 + real(kind_phys) :: rdgas = 1.0E30 + real(kind_phys) :: rvgas = 1.0E30 + real(kind_phys) :: zvir = 1.0E30 + real(kind_phys) :: runiver = 1.0E30 + real(kind_phys) :: cp_air = 1.0E30 + real(kind_phys) :: c_ice = 1.0E30 + real(kind_phys) :: hlv = 1.0E30 + real(kind_phys) :: hlf = 1.0E30 + real(kind_phys) :: rho0 = 1.0E30 + real(kind_phys) :: rhos = 1.0E30 + real(kind_phys) :: one_r8 = 1.0E30 + real(kind_phys) :: con_amd = 1.0E30 + real(kind_phys) :: con_amw = 1.0E30 + real(kind_phys) :: visd = 1.0E30 + real(kind_phys) :: visk = 1.0E30 + real(kind_phys) :: vdifu = 1.0E30 + real(kind_phys) :: tcond = 1.0E30 + real(kind_phys) :: cdg = 1.0E30 + real(kind_phys) :: cdh = 1.0E30 + real(kind_phys) :: rhow = 1.0E30 + real(kind_phys) :: rhoi = 1.0E30 + real(kind_phys) :: rhor = 1.0E30 + real(kind_phys) :: rhog = 1.0E30 + real(kind_phys) :: rhoh = 1.0E30 + real(kind_phys) :: qcmin = 1.0E30 + real(kind_phys) :: qfmin = 1.0E30 + + ! ----------------------------------------------------------------------- ! Physical constants that differ from physcons ! ----------------------------------------------------------------------- @@ -146,14 +154,14 @@ module gfdl_cloud_microphys_v3_mod ! ----------------------------------------------------------------------- ! derived physics constants ! ----------------------------------------------------------------------- - real(kind_phys), parameter :: mmd = con_amd*1e-3 ! (g/mol) -> (kg/mol) - real(kind_phys), parameter :: mmv = con_amw*1e-3 ! (g/mol) -> (kg/mol) - real(kind_phys), parameter :: cv_air = cp_air - rdgas - real(kind_phys), parameter :: cp_vap = 4.0 * rvgas - real(kind_phys), parameter :: cv_vap = 3.0 * rvgas - real(kind_phys), parameter :: dc_vap = cp_vap - c_liq - real(kind_phys), parameter :: dc_ice = c_liq - c_ice - real(kind_phys), parameter :: d2_ice = cp_vap - c_ice + real(kind_phys) :: mmd = 1.0E30 + real(kind_phys) :: mmv = 1.0E30 + real(kind_phys) :: cv_air = 1.0E30 + real(kind_phys) :: cp_vap = 1.0E30 + real(kind_phys) :: cv_vap = 1.0E30 + real(kind_phys) :: dc_vap = 1.0E30 + real(kind_phys) :: dc_ice = 1.0E30 + real(kind_phys) :: d2_ice = 1.0E30 ! ----------------------------------------------------------------------- ! predefined parameters @@ -207,7 +215,15 @@ module gfdl_cloud_microphys_v3_mod ! ======================================================================= subroutine gfdl_cloud_microphys_v3_mod_init (me, master, nlunit, input_nml_file, logunit, & - fn_nml, hydrostatic, errmsg, errflg) + fn_nml, hydrostatic, con_g, con_1ovg, & + con_pi, con_boltz, con_avgd, con_rd, & + con_rv, con_fvirt, con_runiver, con_cp, & + con_csol, con_hvap, con_hfus, con_rhoair_IFS, & + con_rhosnow, con_one, con_amd_in, con_amw_in, & + con_visd, con_visk, con_vdifu, con_tcond, & + con_cdg, con_cdh, con_rhocw, con_rhoci, & + con_rhocr, con_rhocg, con_rhoch, con_qcmin, & + con_qfmin, errmsg, errflg) implicit none @@ -223,6 +239,37 @@ subroutine gfdl_cloud_microphys_v3_mod_init (me, master, nlunit, input_nml_file, character (len = 64), intent (in) :: fn_nml character (len = *), intent (in) :: input_nml_file (:) logical, intent (in) :: hydrostatic + real(kind_phys), intent(in) :: con_g + real(kind_phys), intent(in) :: con_1ovg + real(kind_phys), intent(in) :: con_pi + real(kind_phys), intent(in) :: con_boltz + real(kind_phys), intent(in) :: con_avgd + real(kind_phys), intent(in) :: con_rd + real(kind_phys), intent(in) :: con_rv + real(kind_phys), intent(in) :: con_fvirt + real(kind_phys), intent(in) :: con_runiver + real(kind_phys), intent(in) :: con_cp + real(kind_phys), intent(in) :: con_csol + real(kind_phys), intent(in) :: con_hvap + real(kind_phys), intent(in) :: con_hfus + real(kind_phys), intent(in) :: con_rhoair_IFS + real(kind_phys), intent(in) :: con_rhosnow + real(kind_phys), intent(in) :: con_one + real(kind_phys), intent(in) :: con_amd_in + real(kind_phys), intent(in) :: con_amw_in + real(kind_phys), intent(in) :: con_visd + real(kind_phys), intent(in) :: con_visk + real(kind_phys), intent(in) :: con_vdifu + real(kind_phys), intent(in) :: con_tcond + real(kind_phys), intent(in) :: con_cdg + real(kind_phys), intent(in) :: con_cdh + real(kind_phys), intent(in) :: con_rhocw + real(kind_phys), intent(in) :: con_rhoci + real(kind_phys), intent(in) :: con_rhocr + real(kind_phys), intent(in) :: con_rhocg + real(kind_phys), intent(in) :: con_rhoch + real(kind_phys), intent(in) :: con_qcmin + real(kind_phys), intent(in) :: con_qfmin character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -238,6 +285,48 @@ subroutine gfdl_cloud_microphys_v3_mod_init (me, master, nlunit, input_nml_file, errflg = 0 errmsg = '' + ! Initialize CCPP module level constants + grav = con_g + rgrav = con_1ovg + pi = con_pi + boltzmann = con_boltz + avogadro = con_avgd + rdgas = con_rd + rvgas = con_rv + zvir = con_fvirt + runiver = con_runiver + cp_air = con_cp + c_ice = con_csol + hlv = con_hvap + hlf = con_hfus + rho0 = con_rhoair_IFS + rhos = con_rhosnow + one_r8 = con_one + rhow = con_rhocw + rhoi = con_rhoci + rhor = con_rhocr + rhog = con_rhocg + rhoh = con_rhoch + con_amd = con_amd_in + con_amw = con_amw_in + visd = con_visd + visk = con_visk + vdifu = con_vdifu + tcond = con_tcond + cdg = con_cdg + cdh = con_cdh + qcmin = con_qcmin + qfmin = con_qfmin + + mmd = con_amd*1e-3 ! (g/mol) -> (kg/mol) + mmv = con_amw*1e-3 ! (g/mol) -> (kg/mol) + cv_air = cp_air - rdgas + cp_vap = 4.0 * rvgas + cv_vap = 3.0 * rvgas + dc_vap = cp_vap - c_liq + dc_ice = c_liq - c_ice + d2_ice = cp_vap - c_ice + ! ----------------------------------------------------------------------- ! Read namelist ! ----------------------------------------------------------------------- diff --git a/physics/MP/Morrison_Gettelman/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F index f38a2e756..91c8ee8cb 100644 --- a/physics/MP/Morrison_Gettelman/aer_cloud.F +++ b/physics/MP/Morrison_Gettelman/aer_cloud.F @@ -16,7 +16,6 @@ MODULE aer_cloud use MAPL_ConstantsMod, r8 => MAPL_R8 #endif #ifdef NEMS_GSM - use physcons, only : MAPL_PI => con_pi use machine, only : r8 => kind_phys #endif @@ -94,29 +93,35 @@ MODULE aer_cloud &, grav_par=9.81d0, rgas_par=8.31d0 &, accom_par=1.0d0, eps_par=1d-6 &, zero_par=1.0e-20, great_par=1d20 - &, pi_par=mapl_pi, sq2pi_par=sqrt(pi_par) ! &, pi_par=3.1415927d0, sq2pi_par=sqrt(pi_par) &, sq2_par=1.41421356237d0 ! &, wmw_ice=018d0, amw_ice=0.029d0 &, rgas_ice=8.314d0, grav_ice=9.81d0 - &, cpa_ice=1005.1d0, pi_ice=pi_par + &, cpa_ice=1005.1d0 &, depcoef_ice=0.1d0, thaccom_ice=0.7d0 ! &, To_ice=272.15d0, Tmin_ice=185.d0 &, Pmin_ice=100.0d0, Thom=236.0d0 &, rv_ice=rgas_ice/wmw_ice + real :: pi_par=1.0E30_r8, sq2pi_par=1.0E30_r8 + &, pi_ice=1.0E30_r8 CONTAINS !>\ingroup aer_cloud_mod !! This subroutine calculates - subroutine aer_cloud_init() + subroutine aer_cloud_init(mapl_pi) + real(kind=r8), intent(in) :: mapl_pi real*8 :: daux, sigaux integer ::ix + pi_par=mapl_pi + sq2pi_par=sqrt(pi_par) + pi_ice=pi_par + call AerConversion_base acorr_dust = 2.7e7 diff --git a/physics/MP/Morrison_Gettelman/cldmacro.F b/physics/MP/Morrison_Gettelman/cldmacro.F index a2d5aeb70..ff2b8bcc5 100644 --- a/physics/MP/Morrison_Gettelman/cldmacro.F +++ b/physics/MP/Morrison_Gettelman/cldmacro.F @@ -20,14 +20,6 @@ module cldmacro & MAPL_AIRMW, MAPL_RVAP , MAPL_PI , MAPL_R8 , MAPL_R4 use MAPL_BaseMod, only: MAPL_UNDEF #endif -#ifdef NEMS_GSM - use physcons, MAPL_TICE => con_t0c, MAPL_GRAV => con_g, - & MAPL_CP => con_cp, MAPL_ALHL => con_hvap, - & MAPL_ALHF => con_hfus, MAPL_PI => con_pi, - & MAPL_RGAS => con_rd, MAPL_RVAP => con_rv -#endif - - implicit none @@ -39,6 +31,9 @@ module cldmacro public meltfrz_inst public fix_up_clouds_2M PUBLIC CLOUD_PTR_STUBS +#ifdef NEMS_GSM + public cldmacro_init +#endif !! Some parameters set by PHYSPARAMS @@ -89,15 +84,24 @@ module cldmacro real :: turnrhcrit_upper real :: MIN_RI, MAX_RI, MIN_RL, MAX_RL, RI_ANV - - real, parameter :: T_ICE_MAX = MAPL_TICE +#ifdef NEMS_GSM + real :: MAPL_TICE = 1.0E30 + real :: MAPL_GRAV = 1.0E30 + real :: MAPL_CP = 1.0E30 + real :: MAPL_ALHL = 1.0E30 + real :: MAPL_ALHF = 1.0E30 + real :: MAPL_PI = 1.0E30 + real :: MAPL_RGAS = 1.0E30 + real :: MAPL_RVAP = 1.0E30 + real :: T_ICE_MAX = 1.0E30 + real :: MAPL_ALHS = 1.0E30 + real :: alhlbcp = 1.0E30 + real :: alhfbcp = 1.0E30 + real :: alhsbcp = 1.0E30 +#endif real, parameter :: RHO_W = 1.0e3 real, parameter :: MIN_CLD_FRAC = 1.0e-8 - real, parameter :: MAPL_ALHS = MAPL_ALHL+MAPL_ALHF - real, parameter :: alhlbcp = MAPL_ALHL/MAPL_CP - &, alhfbcp = MAPL_ALHF/MAPL_CP - &, alhsbcp = alhlbcp+alhfbcp ! real, parameter :: PI_0 = 4.*atan(1.) @@ -107,6 +111,28 @@ module cldmacro contains +#ifdef NEMS_GSM + subroutine cldmacro_init(con_t0c, con_g, con_cp, con_hvap & + &, con_hfus, con_pi, con_rd, con_rv) + real, intent(in) :: con_t0c, con_g, con_cp, con_hvap + real, intent(in) :: con_hfus, con_pi, con_rd, con_rv + MAPL_TICE = con_t0c + MAPL_GRAV = con_g + MAPL_CP = con_cp + MAPL_ALHL = con_hvap + MAPL_ALHF = con_hfus + MAPL_PI = con_pi + MAPL_RGAS = con_rd + MAPL_RVAP = con_rv + + T_ICE_MAX = MAPL_TICE + MAPL_ALHS = MAPL_ALHL+MAPL_ALHF + alhlbcp = MAPL_ALHL/MAPL_CP + alhfbcp = MAPL_ALHF/MAPL_CP + alhsbcp = alhlbcp+alhfbcp + end subroutine cldmacro_init +#endif + !>\ingroup cldmacro_mod !! This subroutine is the cloud macrophysics scheme in MG micriphysics. subroutine macro_cloud(IRUN, LM, DT, alf_fac, PP_dev, PPE_dev & diff --git a/physics/MP/Morrison_Gettelman/cldwat2m_micro.F b/physics/MP/Morrison_Gettelman/cldwat2m_micro.F index d0e59bede..64203be38 100644 --- a/physics/MP/Morrison_Gettelman/cldwat2m_micro.F +++ b/physics/MP/Morrison_Gettelman/cldwat2m_micro.F @@ -24,11 +24,6 @@ module cldwat2m_micro #ifdef NEMS_GSM use machine, only : r8 => kind_phys - use physcons, gravit => con_g, rair => con_rd, & - & rh2o => con_rv, epsilon => con_eps, & - & tmelt => con_tice, cpair => con_cp, & - & latvap => con_hvap, latice => con_hfus, & - & pi => con_pi use wv_saturation, only : estblf, hlatv, tmin, hlatf, rgasv, pcf,& & epsqs, ttrice, vqsatd2,cp, & & vqsatd2_single,polysvp,gestbl @@ -68,10 +63,21 @@ module cldwat2m_micro real(r8), parameter :: zero=0.0_r8, one=1.0_r8, two=2.0_r8 & &, three=3.0_r8, four=4.0_r8, five=5.0_r8 & - &, half=0.5_r8, oneb3=one/three & - &, onebcp=one/cpair + &, half=0.5_r8, oneb3=one/three + #ifdef NEMS_GSM ! + real(r8) :: gravit = 1.0E30_r8 + real(r8) :: rair = 1.0E30_r8 + real(r8) :: rh2o = 1.0E30_r8 + real(r8) :: epsilon = 1.0E30_r8 + real(r8) :: tmelt = 1.0E30_r8 + real(r8) :: cpair = 1.0E30_r8 + real(r8) :: latvap = 1.0E30_r8 + real(r8) :: latice = 1.0E30_r8 + real(r8) :: pi = 1.0E30_r8 + real(r8) :: onebcp = 1.0E30_r8 + integer, parameter :: iulog = 6 real(r8), parameter :: rhmini = 0.80_r8 @@ -170,8 +176,13 @@ module cldwat2m_micro &, lammins, lammaxs !> parameters for snow/rain fraction for convective clouds +#ifdef NEMS_GSM + real(r8), private :: tmax_fsnow = 1.0E30_r8 + real(r8), private :: tmin_fsnow = 1.0E30_r8 +#else real(r8), private, parameter :: tmax_fsnow = tmelt &, tmin_fsnow = tmelt-5._r8 +#endif !needed for findsp real(r8), private:: tt0 @@ -187,7 +198,12 @@ module cldwat2m_micro !>\ingroup cldwat2m_micro_mod !! This subroutine initializes constants for MG microphysics. !!\author Andrew Gettelman - subroutine ini_micro(Dcs_, QCVAR_, ts_auto_ice_) + subroutine ini_micro(Dcs_, QCVAR_, ts_auto_ice_ & +#ifdef NEMS_GSM + &, gravit_in, rair_in, rh2o_in, epsilon_in, tmelt_in, cpair_in & + &, latvap_in, latice_in, pi_in & +#endif + & ) !----------------------------------------------------------------------- ! @@ -210,8 +226,24 @@ subroutine ini_micro(Dcs_, QCVAR_, ts_auto_ice_) character(len=16) :: eddy_scheme = ' ' logical :: history_microphysics - - +#ifdef NEMS_GSM + real(r8), intent(in) :: gravit_in, rair_in, rh2o_in, epsilon_in + real(r8), intent(in) :: tmelt_in, cpair_in, latvap_in, latice_in + real(r8), intent(in) :: pi_in + + gravit = gravit_in + rair = rair_in + rh2o = rh2o_in + epsilon = epsilon_in + tmelt = tmelt_in + cpair = cpair_in + latvap = latvap_in + latice = latice_in + pi = pi_in + onebcp = one/cpair + tmax_fsnow = tmelt + tmin_fsnow = tmelt-five +#endif #ifdef CAM diff --git a/physics/MP/Morrison_Gettelman/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 index 9054b42ee..898d2853e 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro.F90 @@ -43,6 +43,9 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, mg_do_ice_gmao, mg_do_liq_liu, errmsg, errflg) use machine, only: kind_phys +#ifdef NEMS_GSM + use cldmacro, only: cldmacro_init +#endif use cldwat2m_micro, only: ini_micro use micro_mg2_0, only: micro_mg_init2_0 => micro_mg_init use micro_mg3_0, only: micro_mg_init3_0 => micro_mg_init @@ -92,7 +95,9 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, lsbcp = (hvap+hfus)*onebcp if (fprcp <= 0) then - call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1)) + call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1), & + gravit, rair, rh2o, eps_in, tmelt, cpair, & + latvap, latice, pi_in) elseif (fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & eps, tmelt, latvap, latice, mg_rhmini,& @@ -127,7 +132,11 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, errmsg = 'ERROR(m_micro_init): fprcp is not a valid option' return endif - call aer_cloud_init () + call aer_cloud_init (pi_in) +#ifdef NEMS_GSM + call cldmacro_init(tice_in, gravit, cpair, latvap, & + latice, pi_in, rair, rh2o) +#endif is_initialized = .true. @@ -164,7 +173,8 @@ subroutine m_micro_run( im, lm, flipv, dt_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) + &, 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 @@ -835,7 +845,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & call gw_prof (1, LM, 1, tm_gw, pm_gw, pi_gw, rhoi_gw, ni_gw, & - & ti_gw, nm_gw, q1(i,:)) + & ti_gw, nm_gw, q1(i,:), grav, cp, rgas, VIREPS) do k=1,lm nm_gw(k) = max(nm_gw(k), 0.005_kp) @@ -1925,10 +1935,8 @@ end subroutine m_micro_run !!\section gw_prof_gen MG gw_prof General Algorithm !> @{ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & - nm, sph) + nm, sph, grav, cp, rgas, fv) use machine , only : kind_phys - use physcons, grav => con_g, cp => con_cp, rgas => con_rd, & - fv => con_fvirt implicit none integer, parameter :: kp = kind_phys !----------------------------------------------------------------------- @@ -1947,20 +1955,28 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & real(kind=kind_phys), intent(in) :: pm(pcols,pver) real(kind=kind_phys), intent(in) :: pi(pcols,0:pver) real(kind=kind_phys), intent(in) :: sph(pcols,pver) + real(kind=kind_phys), intent(in) :: grav ! con_g + real(kind=kind_phys), intent(in) :: cp ! con_cp + real(kind=kind_phys), intent(in) :: rgas ! con_rd + real(kind=kind_phys), intent(in) :: fv ! con_fvirt real(kind=kind_phys), intent(out) :: rhoi(pcols,0:pver) real(kind=kind_phys), intent(out) :: ni(pcols,0:pver) real(kind=kind_phys), intent(out) :: ti(pcols,0:pver) real(kind=kind_phys), intent(out) :: nm(pcols,pver) - real(kind=kind_phys), parameter :: r=rgas, cpair=cp, g=grav, & - oneocp=1.0_kp/cp, n2min=1.0e-8_kp - !---------------------------Local storage------------------------------- + real(kind=kind_phys), parameter :: n2min=1.0e-8_kp + real(kind=kind_phys) :: r, cpair, g, oneocp integer :: ix,kx real :: dtdp, n2 + r=rgas + cpair=cp + g=grav + oneocp=1.0_kp/cp + !----------------------------------------------------------------------------- !> -# Determine the interface densities and Brunt-Vaisala frequencies. !----------------------------------------------------------------------------- diff --git a/physics/MP/Morrison_Gettelman/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta index 2567b59bb..ae3b89545 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../hooks/machine.F dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F dependencies = micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F diff --git a/physics/MP/calpreciptype.f90 b/physics/MP/calpreciptype.f90 index dd616fd53..6f5370f92 100644 --- a/physics/MP/calpreciptype.f90 +++ b/physics/MP/calpreciptype.f90 @@ -11,6 +11,8 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & xlat,xlon, & gt0,gq0,prsl,prsi,prec, & !input phii,tskin, & !input + con_g, con_eps, con_epsm1, & !input + con_epsq, con_fvirt, con_rog, & !input domr,domzr,domip,doms) !output !$$$ subprogram documentation block @@ -25,12 +27,12 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & ! ! -------------------------------------------------------------------- use funcphys, only : fpvs,ftdp,fpkap,ftlcl,stma,fthe - use physcons use machine , only : kind_phys !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none ! - real(kind=kind_phys), parameter :: pthresh = 0.0, oneog = 1.0/con_g + real(kind=kind_phys), parameter :: pthresh = 0.0 + real(kind=kind_phys) :: oneog integer,parameter :: nalg = 5 ! ! declare variables. @@ -42,6 +44,8 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & real(kind=kind_phys),dimension(ix,lm), intent(in) :: gt0,gq0,prsl real(kind=kind_phys),dimension(ix,lp1),intent(in) :: prsi,phii real(kind=kind_phys),dimension(im), intent(out) :: domr,domzr,domip,doms + real(kind=kind_phys),intent(in) :: con_g, con_eps, con_epsm1 + real(kind=kind_phys),intent(in) :: con_epsq, con_fvirt, con_rog integer, dimension(nalg) :: sleet,rain,freezr,snow real(kind=kind_phys),dimension(lm) :: t,q,pmid @@ -53,6 +57,7 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & time_vert,time_ncep,time_ramer,time_bourg,time_revised,& time_dominant,btim,timef,ranl(2) + oneog = 1.0/con_g ! ! computes wet bulb here since two algorithms use it ! lp1=lm+1 diff --git a/physics/MP/multi_gases.F90 b/physics/MP/multi_gases.F90 index 0e241f017..79e92c794 100644 --- a/physics/MP/multi_gases.F90 +++ b/physics/MP/multi_gases.F90 @@ -37,8 +37,6 @@ module ccpp_multi_gases_mod ! use machine, only: kind_dyn ! DH* TODO - MAKE THIS INPUT ARGUMENTS - use physcons, only : rdgas => con_rd_dyn, & - cp_air => con_cp_dyn ! *DH implicit none @@ -65,7 +63,7 @@ module ccpp_multi_gases_mod CONTAINS ! -------------------------------------------------------- - subroutine multi_gases_init(ngas, nwat, ri, cpi, is_master) + subroutine multi_gases_init(ngas, nwat, ri, cpi, rdgas, cp_air, is_master) !-------------------------------------------- ! !OUTPUT PARAMETERS ! Ouput: vir(i): ri/rdgas - r0/rdgas @@ -79,6 +77,8 @@ subroutine multi_gases_init(ngas, nwat, ri, cpi, is_master) integer, intent(in):: ngas, nwat real(kind=kind_dyn), intent(in):: ri(0:ngas) real(kind=kind_dyn), intent(in):: cpi(0:ngas) + real(kind=kind_dyn), intent(in):: rdgas + real(kind=kind_dyn), intent(in):: cp_air logical, intent(in):: is_master ! Local: integer n diff --git a/physics/PBL/HEDMF/hedmf.f b/physics/PBL/HEDMF/hedmf.f index 166e0f727..43b5e73c6 100644 --- a/physics/PBL/HEDMF/hedmf.f +++ b/physics/PBL/HEDMF/hedmf.f @@ -77,15 +77,15 @@ subroutine hedmf_run (im,km,ntrac,ntcw,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,ten_t,ten_u,ten_v,errmsg,errflg) + & flag_for_pbl_generic_tend,ten_t,ten_u,ten_v, & + & con_g, con_cp, con_hvap, con_fvirt, & + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs !GJF: Note that sending these constants through the argument list !results in regression test failures with "PROD" mode compilation !flags (specifically, grav and cp) - use physcons, grav => con_g, cp => con_cp, - & hvap => con_hvap, fv => con_fvirt implicit none ! @@ -135,6 +135,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,rtg, & ! flag for tke dissipative heating real(kind=kind_phys), intent(out) :: ten_t(:,:), & & ten_u(:,:), ten_v(:,:) + real(kind=kind_phys), intent(in) :: con_g, con_cp + real(kind=kind_phys), intent(in) :: con_hvap, con_fvirt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -217,12 +219,11 @@ subroutine hedmf_run (im,km,ntrac,ntcw,rtg, & integer kLOC ! RGF real :: xDKU ! RGF + real(kind=kind_phys) :: grav, cp, hvap, fv + integer, parameter :: useshape=2!0-- no change, original ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax cc - parameter(gravi=1.0/grav) - parameter(gocp=grav/cp) - parameter(cont=cp/grav,conq=hvap/grav,conw=1.0/grav) ! for del in pa ! parameter(cont=1000.*cp/grav,conq=1000.*hvap/grav,conw=1000./grav) ! for del in kpa parameter(rlam=30.0,vk=0.4,vk2=vk*vk) parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) @@ -271,6 +272,17 @@ subroutine hedmf_run (im,km,ntrac,ntcw,rtg, & errmsg = '' errflg = 0 + grav = con_g + cp = con_cp + hvap = con_hvap + fv = con_fvirt + + gravi=1.0/grav + gocp=grav/cp + cont=cp/grav + conq=hvap/grav + conw=1.0/grav + ! compute preliminary variables ! ! iprt = 0 @@ -1109,7 +1121,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,rtg, & !> For details of the mfpbl subroutine, step into its documentation ::mfpbl call mfpbl(im,im,km,ntrac,dt2,pcnvflg, & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, - & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) + & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko,con_g,con_cp) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! compute diffusion coefficients for cloud-top driven diffusion diff --git a/physics/PBL/HEDMF/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta index fe3c15b46..cbc5709b1 100644 --- a/physics/PBL/HEDMF/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = hedmf type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90,../mfpbl.f,../tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -574,6 +574,38 @@ type = real kind = kind_phys intent = out +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/SATMEDMF/mfscu.f b/physics/PBL/SATMEDMF/mfscu.f index a9faa735e..f5a2cf1b0 100644 --- a/physics/PBL/SATMEDMF/mfscu.f +++ b/physics/PBL/SATMEDMF/mfscu.f @@ -14,14 +14,11 @@ subroutine mfscu(im,ix,km,kmscu,ntcw,ntrac1,delt, & & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix, & & thlx,thvx,thlvx,gdx,thetae,radj, & & krad,mrad,radmin,buo,xmfd, & - & tcdo,qcdo,ucdo,vcdo,xlamde) + & tcdo,qcdo,ucdo,vcdo,xlamde, & + & con_g,con_cp,con_rv,con_hvap,con_fvirt,con_eps,con_epsm1) ! use machine , only : kind_phys use funcphys , only : fpvs - use physcons, grav => con_g, cp => con_cp & - &, rv => con_rv, hvap => con_hvap & - &, fv => con_fvirt & - &, eps => con_eps, epsm1 => con_epsm1 ! implicit none ! @@ -43,6 +40,8 @@ subroutine mfscu(im,ix,km,kmscu,ntcw,ntrac1,delt, & & tcdo(im,km), qcdo(im,km,ntrac1), & & ucdo(im,km), vcdo(im,km), & & xlamde(im,km-1) + real(kind=kind_phys), intent(in) :: con_g,con_cp,con_rv,con_hvap + real(kind=kind_phys), intent(in) :: con_fvirt,con_eps,con_epsm1 ! ! local variables and arrays ! @@ -76,9 +75,6 @@ subroutine mfscu(im,ix,km,kmscu,ntcw,ntrac1,delt, & real(kind=kind_phys) actei, cldtime ! c physical parameters - parameter(g=grav) - parameter(gocp=g/cp) - parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) parameter(ce0=0.4,cm=1.0,pgcon=0.55) parameter(qmin=1.e-8,qlmin=1.e-12) parameter(b1=0.45,f1=0.15) @@ -88,8 +84,21 @@ subroutine mfscu(im,ix,km,kmscu,ntcw,ntrac1,delt, & parameter(actei = 0.7) ! parameter(actei = 0.23) ! + real(kind=kind_phys) :: grav, cp, rv, hvap, fv, eps, epsm1 !************************************************************************ !! + grav = con_g + cp = con_cp + rv = con_rv + hvap = con_hvap + fv = con_fvirt + eps = con_eps + epsm1 = con_epsm1 + g=grav + gocp=g/cp + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) + totflg = .true. do i=1,im totflg = totflg .and. (.not. cnvflg(i)) diff --git a/physics/PBL/SATMEDMF/mfscuq.f b/physics/PBL/SATMEDMF/mfscuq.f index a934cf5e9..3feb37d1c 100644 --- a/physics/PBL/SATMEDMF/mfscuq.f +++ b/physics/PBL/SATMEDMF/mfscuq.f @@ -15,14 +15,12 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, & krad,mrad,radmin,buo,wush,tkemean,vez0fun,xmfd, - & tcdo,qcdo,ucdo,vcdo,xlamdeq,a1) + & tcdo,qcdo,ucdo,vcdo,xlamdeq,a1, +! the following are constants being passed in + & con_g, con_cp, con_rv, con_hvap, con_fvirt, con_eps, con_epsm1) ! use machine , only : kind_phys use funcphys , only : fpvs - use physcons, grav => con_g, cp => con_cp - &, rv => con_rv, hvap => con_hvap - &, fv => con_fvirt - &, eps => con_eps, epsm1 => con_epsm1 ! implicit none ! @@ -45,6 +43,9 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, & tcdo(im,km),qcdo(im,km,ntrac1), & ucdo(im,km),vcdo(im,km), & xlamdeq(im,km-1) + real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rv + real(kind=kind_phys), intent(in) :: con_hvap, con_fvirt + real(kind=kind_phys), intent(in) :: con_eps, con_epsm1 ! ! local variables and arrays ! @@ -79,11 +80,10 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, logical totflg, flg(im) ! real(kind=kind_phys) actei, cldtime + real(kind=kind_phys) :: grav, cp, rv, hvap, fv, eps, epsm1 + ! c physical parameters - parameter(g=grav) - parameter(gocp=g/cp) - parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) parameter(ce0=0.4,cm=1.0,cq=1.0,pgcon=0.55) parameter(tkcrt=2.,cmxfac=5.) parameter(qmin=1.e-8,qlmin=1.e-12) @@ -95,6 +95,21 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, ! !************************************************************************ !! +! variable initialization + grav = con_g + rv = con_rv + hvap = con_hvap + fv = con_fvirt + eps = con_eps + epsm1 = con_epsm1 + g = grav + cp = con_cp + gocp = g/cp + elocp = hvap/cp + el2orc = hvap*hvap/(rv*cp) + + + totflg = .true. do i=1,im totflg = totflg .and. (.not. cnvflg(i)) diff --git a/physics/PBL/SATMEDMF/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F index 6d10d529d..8d818922e 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdif.F +++ b/physics/PBL/SATMEDMF/satmedmfvdif.F @@ -820,14 +820,18 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & call mfpblt(im,im,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,xmf, - & tcko,qcko,ucko,vcko,xlamue) + & tcko,qcko,ucko,vcko,xlamue, + & grav,cp,rv,hvap, + & fv,eps,epsm1) !> - Call mfscu(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. call mfscu(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae,radj, & krad,mrad,radmin,buod,xmfd, - & tcdo,qcdo,ucdo,vcdo,xlamde) + & tcdo,qcdo,ucdo,vcdo,xlamde, + & grav,cp,rv,hvap, + & fv,eps,epsm1) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> -# Compute Prandtl number \f$P_r\f$ (prn) and exchange coefficient varying with height diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 0eff65450..16b0eb4c7 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -1224,14 +1224,16 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & call mfpbltq(im,im,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,wush,tkemean,vez0fun,xmf, - & tcko,qcko,ucko,vcko,xlamue,bl_upfr) + & tcko,qcko,ucko,vcko,xlamue,bl_upfr, + & grav,cp,rv,hvap,fv,eps,epsm1) !> - Call mfscuq(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq call mfscuq(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, & krad,mrad,radmin,buod,wush,tkemean,vez0fun,xmfd, - & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) + & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr, + & grav,cp,rv,hvap,fv,eps,epsm1) if (tc_pbl == 1) then !> - unify mass fluxes with Cu diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq_can.F b/physics/PBL/SATMEDMF/satmedmfvdifq_can.F index a3332101b..6051c5820 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq_can.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq_can.F @@ -1177,14 +1177,16 @@ subroutine satmedmfvdifq_can(im,km,ntrac,ntcw,ntrw, call mfpbltq(im,im,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,wush,tkemean,vez0fun,xmf, - & tcko,qcko,ucko,vcko,xlamue,bl_upfr) + & tcko,qcko,ucko,vcko,xlamue,bl_upfr, + & grav,cp,rv,hvap,fv,eps,epsm1) !> - Call mfscuq(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq call mfscuq(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, & krad,mrad,radmin,buod,wush,tkemean,vez0fun,xmfd, - & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) + & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr, + & grav,cp,rv,hvap,fv,eps,epsm1) if (tc_pbl == 1) then !> - unify mass fluxes with Cu diff --git a/physics/PBL/mfpbl.f b/physics/PBL/mfpbl.f index c9629ac2b..e2317b0e1 100644 --- a/physics/PBL/mfpbl.f +++ b/physics/PBL/mfpbl.f @@ -47,10 +47,9 @@ module mfpbl_mod !! @{ subroutine mfpbl(im,ix,km,ntrac,delt,cnvflg, & & zl,zm,thvx,q1,t1,u1,v1,hpbl,kpbl, & - & sflx,ustar,wstar,xmf,tcko,qcko,ucko,vcko) + & sflx,ustar,wstar,xmf,tcko,qcko,ucko,vcko,con_g,con_cp) ! use machine , only : kind_phys - use physcons, grav => con_g, cp => con_cp ! implicit none ! @@ -67,6 +66,8 @@ subroutine mfpbl(im,ix,km,ntrac,delt,cnvflg, & & wstar(im), xmf(im,km), & & tcko(im,km),qcko(im,km,ntrac), & & ucko(im,km),vcko(im,km) + real(kind=kind_phys), intent(in) :: con_g + real(kind=kind_phys), intent(in) :: con_cp ! c local variables and arrays ! @@ -91,14 +92,25 @@ subroutine mfpbl(im,ix,km,ntrac,delt,cnvflg, & & buo(im,km) ! logical totflg, flg(im) + real(kind=kind_phys) :: grav + real(kind=kind_phys) :: cp ! + grav = con_g + cp = con_cp c physical parameters - parameter(g=grav) - parameter(gocp=g/cp) + g=grav + gocp=g/cp ! parameter(ce0=0.37,qmin=1.e-8,alp=1.0,pgcon=0.55) - parameter(ce0=0.38,qmin=1.e-8,alp=1.0,pgcon=0.55) - parameter(a1=0.08,b1=0.5,f1=0.15,c1=0.3,d1=2.58,tau=500.) - parameter(zfmin=1.e-8,h1=0.33333333) + ce0=0.38 + qmin=1.e-8 + alp=1.0 + pgcon=0.55 + a1=0.08 + b1=0.5 + f1=0.15 +c 1=0.3,d1=2.58,tau=500. + zfmin=1.e-8 + h1=0.33333333 ! c----------------------------------------------------------------------- ! diff --git a/physics/PBL/mfpblt.f b/physics/PBL/mfpblt.f index 52179b35a..33e9a11e4 100644 --- a/physics/PBL/mfpblt.f +++ b/physics/PBL/mfpblt.f @@ -16,14 +16,11 @@ module mfpblt_mod subroutine mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,delt, & & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & & gdx,hpbl,kpbl,vpert,buo,xmf, & - & tcko,qcko,ucko,vcko,xlamue) + & tcko,qcko,ucko,vcko,xlamue, & + & con_g,con_cp,con_rv,con_hvap,con_fvirt,con_eps,con_epsm1) ! use machine , only : kind_phys use funcphys , only : fpvs - use physcons, grav => con_g, cp => con_cp & - &, rv => con_rv, hvap => con_hvap & - &, fv => con_fvirt & - &, eps => con_eps, epsm1 => con_epsm1 ! implicit none ! @@ -64,6 +61,9 @@ subroutine mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,delt, & real(kind=kind_phys) rbdn(im), rbup(im), hpblx(im), & xlamuem(im,km-1) ! + real(kind=kind_phys), intent(in) :: con_g,con_cp,con_rv,con_hvap + real(kind=kind_phys), intent(in) :: con_fvirt,con_eps,con_epsm1 + real(kind=kind_phys) wu2(im,km), thlu(im,km), & qtx(im,km), qtu(im,km) ! @@ -73,16 +73,26 @@ subroutine mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,delt, & logical totflg, flg(im) ! ! physical parameters - parameter(g=grav) - parameter(gocp=g/cp) - parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) parameter(ce0=0.4,cm=1.0) parameter(qmin=1.e-8,qlmin=1.e-12) parameter(alp=1.0,pgcon=0.55) parameter(a1=0.13,b1=0.5,f1=0.15) + real(kind=kind_phys) :: grav, cp, rv, hvap, fv, eps, epsm1 ! !************************************************************************ !! + grav = con_g + cp = con_cp + rv = con_rv + hvap = con_hvap + fv = con_fvirt + eps = con_eps + epsm1 = con_epsm1 + g=grav + gocp=g/cp + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) + totflg = .true. do i=1,im totflg = totflg .and. (.not. cnvflg(i)) diff --git a/physics/PBL/mfpbltq.f b/physics/PBL/mfpbltq.f index 8bf687757..ea5714265 100644 --- a/physics/PBL/mfpbltq.f +++ b/physics/PBL/mfpbltq.f @@ -16,14 +16,12 @@ module mfpbltq_mod subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, & cnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buo,wush,tkemean,vez0fun,xmf, - & tcko,qcko,ucko,vcko,xlamueq,a1) + & tcko,qcko,ucko,vcko,xlamueq,a1, +! The following are constants being passed in by argument + & con_g,con_cp,con_rv,con_hvap,con_fvirt,con_eps,con_epsm1) ! use machine , only : kind_phys use funcphys , only : fpvs - use physcons, grav => con_g, cp => con_cp - &, rv => con_rv, hvap => con_hvap - &, fv => con_fvirt - &, eps => con_eps, epsm1 => con_epsm1 ! implicit none ! @@ -42,6 +40,8 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, & tcko(im,km),qcko(im,km,ntrac1), & ucko(im,km),vcko(im,km), & xlamueq(im,km-1) + real(kind=kind_phys), intent(in) :: con_g,con_cp,con_rv,con_hvap + real(kind=kind_phys), intent(in) :: con_fvirt,con_eps,con_epsm1 ! c local variables and arrays ! @@ -72,12 +72,10 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, real(kind=kind_phys) xlamavg(im), sigma(im), & scaldfunc(im), sumx(im) ! + real(kind=kind_phys) :: grav, cp, rv, hvap, fv, eps, epsm1 logical totflg, flg(im) ! ! physical parameters - parameter(g=grav) - parameter(gocp=g/cp) - parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) parameter(ce0=0.4,cm=1.0,cq=1.0,tkcrt=2.,cmxfac=5.) parameter(qmin=1.e-8,qlmin=1.e-12) parameter(alp=1.5,vpertmax=3.0,pgcon=0.55) @@ -85,6 +83,18 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, ! !************************************************************************ !! + grav = con_g + cp = con_cp + rv = con_rv + hvap = con_hvap + fv = con_fvirt + eps = con_eps + epsm1 = con_epsm1 + g=grav + gocp=g/cp + elocp=hvap/cp + el2orc=hvap*hvap/(rv*cp) + totflg = .true. do i=1,im totflg = totflg .and. (.not. cnvflg(i)) diff --git a/physics/Radiation/RRTMG/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f index 6285653d2..80cd8e9d8 100644 --- a/physics/Radiation/RRTMG/module_bfmicrophysics.f +++ b/physics/Radiation/RRTMG/module_bfmicrophysics.f @@ -6,10 +6,6 @@ MODULE module_microphysics ! USE MACHINE , ONLY : kind_phys USE FUNCPHYS - USE PHYSCONS, CP => con_CP, RD => con_RD, RV => con_RV & - &, T0C => con_T0C, HVAP => con_HVAP, HFUS => con_HFUS & - &, EPS => con_EPS, EPSM1 => con_EPSM1 & - &, EPS1 => con_FVirt, pi => con_pi, grav => con_g implicit none ! !--- Common block of constants used in column microphysics @@ -116,7 +112,7 @@ MODULE module_microphysics CONTAINS ! !> This subroutine initializes constants & lookup tables for microphysics. - SUBROUTINE GSMCONST (DTPG,mype,first) + SUBROUTINE GSMCONST (DTPG,mype,first, pi, t0c) ! implicit none !------------------------------------------------------------------------------- @@ -156,6 +152,7 @@ SUBROUTINE GSMCONST (DTPG,mype,first) integer mype real dtpg logical first + real, intent(in) :: pi, t0c ! !--- Parameters & data statement for local calculations ! @@ -231,8 +228,8 @@ SUBROUTINE GSMCONST (DTPG,mype,first) ! read(1) my_growth ! Applicable only for DTPH=180 s for offline testing CLOSE (1) else - CALL ICE_LOOKUP ! Lookup tables for ice - CALL RAIN_LOOKUP ! Lookup tables for rain + CALL ICE_LOOKUP(pi) ! Lookup tables for ice + CALL RAIN_LOOKUP(pi) ! Lookup tables for rain if (write_lookup) then open(unit=1,file='micro_lookup.dat',form='unformatted') write(1) ventr1 @@ -425,7 +422,7 @@ SUBROUTINE MY_GROWTH_RATES (DTPH) END subroutine MY_GROWTH_RATES ! !> This subroutine creates lookup tables for ice processes. - subroutine ice_lookup + subroutine ice_lookup(pi) ! implicit none !----------------------------------------------------------------------------------- @@ -455,8 +452,9 @@ subroutine ice_lookup ! - DmaxI - maximum diameter for integration (2 cm) ! - DdelI - interval for integration (1 micron) ! + real, intent(in) :: pi real, parameter :: DminI=.02e-3, DmaxI=20.e-3, DdelI=1.e-6, & - & XImin=1.e6*DminI, XImax=1.e6*DmaxI + & XImin=1.e6*DminI, XImax=1.e6*DmaxI integer, parameter :: IDImin=XImin, IDImax=XImax ! !---- Meaning of the following arrays: @@ -957,7 +955,7 @@ subroutine ice_lookup end subroutine ice_lookup ! !> This subroutine creates lookup tables for rain processes. - subroutine rain_lookup + subroutine rain_lookup(pi) implicit none ! !--- Parameters & arrays for fall speeds of rain as a function of rain drop @@ -966,6 +964,7 @@ subroutine rain_lookup ! drop sizes of .05 mm (50 microns, DminR) to maximum drop sizes of 10 mm ! (DmaxR). ! + real, intent(in) :: pi real, parameter :: DminR=.05e-3, DmaxR=10.e-3, DdelR=1.e-6, & & XRmin=1.e6*DminR, XRmax=1.e6*DmaxR integer, parameter :: IDRmin=XRmin, IDRmax=XRmax @@ -1122,7 +1121,9 @@ end subroutine rain_lookup ! SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & & LSFC, P_col, QI_col, QR_col, QV_col, QW_col, RimeF_col, T_col, & - & THICK_col, WC_col, LM, RHC_col, XNCW, FLGmin, PRINT_diag, psfc) + & THICK_col, WC_col, LM, RHC_col, XNCW, FLGmin, PRINT_diag, psfc, & + & con_hvap, con_hfus, con_cp, con_rv, con_t0c, con_rd, con_epsm1, & + & con_fvirt, con_eps) ! implicit none ! @@ -1202,6 +1203,8 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & REAL ARAING, ASNOWG, P_col(LM), QI_col(LM), QR_col(LM), QV_col(LM)& &, QW_col(LM), RimeF_col(LM), T_col(LM), THICK_col(LM), & & WC_col(LM), RHC_col(LM), XNCW(LM), ARAIN, ASNOW, dtpg, psfc + real, intent(in) :: con_hvap, con_hfus, con_cp, con_rv, con_t0c + real, intent(in) :: con_rd, con_epsm1, con_fvirt, con_eps real flgmin ! INTEGER I_index, J_index, LSFC @@ -1244,7 +1247,8 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & !-- NLImax - maximum number concentration of large ice crystals (20,000 /m**3, 20 per liter) !-- NLImin - minimum number concentration of large ice crystals (100 /m**3, 0.1 per liter) ! - REAL, PARAMETER :: RHOL=1000., XLS=HVAP+HFUS & + REAL :: XLS, CLIMIT, RCP, RCPRV, RRHOLD, XLS1, XLS2, XLS3 + REAL, PARAMETER :: RHOL=1000., & ! &, T_ICE=-10. !- Ver1 ! &, T_ICE_init=-5. !- Ver1 @@ -1253,10 +1257,6 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & ! &, T_ICE_init=-15., !- Ver2 ! ! & CLIMIT=10.*EPSQ, EPS1=RV/RD-1., RCP=1./CP, - - &,CLIMIT=10.*EPSQ, RCP=1./CP, & - & RCPRV=RCP/RV, RRHOL=1./RHOL, XLS1=XLS*RCP, XLS2=XLS*XLS*RCPRV, & - & XLS3=XLS*XLS/RV, & & C1=1./3., C2=1./6., C3=3.31/6., & & DMR1=.1E-3, DMR2=.2E-3, DMR3=.32E-3, N0r0=8.E6, N0rmin=1.e4, & & N0s0=4.E6, RHO0=1.194, XMR1=1.e6*DMR1, XMR2=1.e6*DMR2, & @@ -1315,12 +1315,32 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & &, piacw, piacwi, piacwr, qv, dwvi & &, arainnew, thick, asnownew & &, qinew, qi_min_0c, QSW_l, QSI_l, QSW0_l, SCHMIT_FAC + real :: cp, rv, hvap, hfus, t0c, rrhol, rd, epsm1, eps1, eps ! ! !####################################################################### !########################## Begin Execution ############################ !####################################################################### + CP = con_CP + RD = con_RD + RV = con_RV + T0C = con_T0C + HVAP = con_HVAP + HFUS = con_HFUS + EPS = con_EPS + EPSM1 = con_EPSM1 + EPS1 = con_FVirt + + + XLS=HVAP+HFUS + CLIMIT=10.*EPSQ + RCP=1./CP + RCPRV=RCP/RV + RRHOL=1./RHOL + XLS1=XLS*RCP + XLS2=XLS*XLS*RCPRV + XLS3=XLS*XLS/RV ! DTPH = DTPG / mic_step ARAING = 0. ! Total Accumulated rainfall at surface (kg/m**2) @@ -1767,7 +1787,8 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & DUM = RHgrd*EPS*DUM/(pp+epsm1*dum) ! Updated (dummy) saturation specific humidity w/r/t ice ! DUM = RHgrd*EPS*DUM/(PP-DUM) ! Updated (dummy) saturation mixing ratio w/r/t ice - IF (DUM2 > DUM) PIDEP = DEPOSIT(PP, RHgrd, DUM1, DUM2) + IF (DUM2 > DUM) PIDEP = DEPOSIT(PP, RHgrd, & + & DUM1, DUM2, CP, RV, HVAP, HFUS) DWVi = 0. ! Used only for debugging ! @@ -1850,7 +1871,7 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & ! IF (TC >= T_ICE .AND. (QW > EPSQ .OR. WV > QSWgrd)) THEN IF (PIACWI == 0. .AND. PIDEP == 0.) THEN - PCOND = CONDENSE (PP, QW, RHgrd, TK, WV) + PCOND = CONDENSE (PP, QW, RHgrd, TK, WV, CP, RV) ELSE !-- Modify cloud condensation in response to ice processes DUM = XLV*QSWgrd*RCPRV*TK2 DENOMWI = 1. + XLS*DUM @@ -2509,7 +2530,7 @@ SUBROUTINE GSMCOLUMN ( ARAING, ASNOWG, DTPG, I_index, J_index, & !--------- Produces accurate calculation of cloud condensation --------- !####################################################################### ! - REAL FUNCTION CONDENSE (PP, QW, RHgrd, TK, WV) + REAL FUNCTION CONDENSE (PP, QW, RHgrd, TK, WV, CP, RV) ! implicit none ! @@ -2520,11 +2541,12 @@ REAL FUNCTION CONDENSE (PP, QW, RHgrd, TK, WV) !--------------------------------------------------------------------------------- ! real pp, qw, rhgrd, tk, wv + real, intent(in) :: cp, rv INTEGER, PARAMETER :: HIGH_PRES=kind_phys ! INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15) REAL (KIND=HIGH_PRES), PARAMETER :: & & RHLIMIT=.001, RHLIMIT1=-RHLIMIT - REAL, PARAMETER :: RCP=1./CP, RCPRV=RCP/RV + REAL :: RCP, RCPRV REAL (KIND=HIGH_PRES) :: COND, SSAT, WCdum, tsq real wvdum, tdum, xlv, xlv1, xlv2, ws, dwv, esw, rfac ! @@ -2536,6 +2558,8 @@ REAL FUNCTION CONDENSE (PP, QW, RHgrd, TK, WV) ! XLV1=XLV*RCP ! XLV2=XLV*XLV*RCPRV ! + RCP=1./CP + RCPRV=RCP/RV Tdum = TK WVdum = WV WCdum = QW @@ -2576,7 +2600,7 @@ END FUNCTION CONDENSE !---------------- Calculate ice deposition at T ... begin here @@ -714,6 +713,9 @@ subroutine rrtmg_lw_run & errmsg = '' errflg = 0 + amdw = con_amd/con_amw + amdo3 = con_amd/con_amo3 + !mz* ! For passing in cloud physical properties; cloud optics parameterized ! in RRTMG: @@ -1322,7 +1324,7 @@ end subroutine rrtmg_lw_run !!\section rlwinit_gen rlwinit General Algorithm subroutine rlwinit( me, rad_hr_units, inc_minor_gas, ilwcliq, & isubclw, iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr,& - iovr_exp, iovr_exprand, errflg, errmsg ) + iovr_exp, iovr_exprand, con_g, con_cp, errflg, errmsg ) ! =================== program usage description =================== ! ! ! @@ -1394,7 +1396,7 @@ subroutine rlwinit( me, rad_hr_units, inc_minor_gas, ilwcliq, & iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, iovr_exp, & iovr_exprand logical, intent(in) :: inc_minor_gas - + real(kind=kind_phys), intent(in) :: con_g, con_cp ! --- outputs: character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index ec90cc533..44ea43036 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw type = scheme - dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radlw_datatb.f,radlw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,radlw_datatb.f,radlw_param.f ######################################################################## [ccpp-arg-table] @@ -428,6 +428,46 @@ type = real kind = kind_phys intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amd] + standard_name = molecular_weight_of_dry_air + long_name = molecular weight of dry air + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amw] + standard_name = molecular_weight_of_water_vapor + long_name = molecular weight of water vapor + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amo3] + standard_name = molecular_weight_of_ozone + long_name = molecular weight of ozone + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_avgd] + standard_name = avogadro_constant + long_name = Avogadro constant + units = mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index d21c07d5a..5cb23a00d 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -90,7 +90,6 @@ ! ! ! external modules referenced: ! ! ! -! 'module physcons' ! ! 'mersenne_twister' ! ! ! ! compilation sequence is: ! @@ -303,8 +302,6 @@ !! rrtmg-sw radiation code from aer inc. module rrtmg_sw ! - use physcons, only : con_g, con_cp, con_avgd, con_amd, & - & con_amw, con_amo3 use machine, only : rb => kind_phys, im => kind_io4, & & kind_phys, kind_dbl_prec @@ -345,10 +342,6 @@ module rrtmg_sw real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 -! \name atomic weights for conversion from mass to volume mixing ratios - real (kind=kind_phys), parameter :: amdw = con_amd/con_amw - real (kind=kind_phys), parameter :: amdo3 = con_amd/con_amo3 - ! \name band indices integer, dimension(nblow:nbhgh) :: nspa, nspb ! band index for sfc flux @@ -506,7 +499,9 @@ subroutine rrtmg_sw_run & & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy, errmsg, errflg & + & cld_od, cld_ssa, cld_asy, & + & con_g, con_avgd, con_amd, con_amw, con_amo3, & + & errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -719,6 +714,8 @@ subroutine rrtmg_sw_run & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, cld_ssa, cld_asy + real(kind=kind_phys), intent(in) :: con_g, con_avgd, con_amd + real(kind=kind_phys), intent(in) :: con_amw, con_amo3 real(kind=kind_phys),dimension(:,:,:),intent(in)::aeraod real(kind=kind_phys),dimension(:,:,:),intent(in)::aerssa @@ -790,6 +787,9 @@ subroutine rrtmg_sw_run & integer :: i, ib, ipt, j1, k, kk, laytrop, mb, ig integer :: inflgsw, iceflgsw, liqflgsw integer :: irng, permuteseed +! \name atomic weights for conversion from mass to volume mixing ratios + real (kind=kind_phys) :: amdw + real (kind=kind_phys) :: amdo3 ! !===> ... begin here ! @@ -797,6 +797,9 @@ subroutine rrtmg_sw_run & errmsg = '' errflg = 0 + ! Set atomic weights + amdw = con_amd/con_amw + amdo3 = con_amd/con_amo3 ! Select cloud liquid and ice optics parameterization options ! For passing in cloud optical properties directly: ! inflgsw = 0 @@ -1389,7 +1392,8 @@ end subroutine rrtmg_sw_run !----------------------------------- subroutine rswinit( me, rad_hr_units, inc_minor_gas, iswcliq, & isubcsw, iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr,& - iovr_exp, iovr_exprand, iswmode, errflg, errmsg ) + iovr_exp, iovr_exprand, iswmode, con_g, con_cp, & + errflg, errmsg ) ! =================== program usage description =================== ! ! ! @@ -1447,6 +1451,7 @@ subroutine rswinit( me, rad_hr_units, inc_minor_gas, iswcliq, & iswmode, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & iovr_exp, iovr_exprand logical, intent(in) :: inc_minor_gas + real(kind=kind_phys), intent(in) :: con_cp, con_g ! --- outputs: character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/Radiation/RRTMG/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta index 55b7c29b3..b216e2679 100644 --- a/physics/Radiation/RRTMG/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw type = scheme - dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radsw_datatb.f,radsw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,radsw_datatb.f,radsw_param.f ######################################################################## [ccpp-arg-table] @@ -497,6 +497,46 @@ type = real kind = kind_phys intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_avgd] + standard_name = avogadro_constant + long_name = Avogadro constant + units = mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amd] + standard_name = molecular_weight_of_dry_air + long_name = molecular weight of dry air + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amw] + standard_name = molecular_weight_of_water_vapor + long_name = molecular weight of water vapor + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amo3] + standard_name = molecular_weight_of_ozone + long_name = molecular weight of ozone + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/radiation_surface.f b/physics/Radiation/radiation_surface.f index 1dbe687bc..f5490e27b 100644 --- a/physics/Radiation/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -40,7 +40,6 @@ ! external modules referenced: ! ! ! ! 'module machine' in 'machine.f' ! -! 'module physcons' in 'physcons.f' ! ! 'module module_iounitdef' in 'iounitdef.f' ! ! ! ! ! diff --git a/physics/SFC_Layer/MYNN/MYNN b/physics/SFC_Layer/MYNN/MYNN index cce9a5fc4..642bf38b3 160000 --- a/physics/SFC_Layer/MYNN/MYNN +++ b/physics/SFC_Layer/MYNN/MYNN @@ -1 +1 @@ -Subproject commit cce9a5fc4479749f489be24020e5c06c3e4202d4 +Subproject commit 642bf38b346e6bf9d5c46c4fba53d465dc2d0e03 diff --git a/physics/SFC_Layer/UFS/module_nst_model.f90 b/physics/SFC_Layer/UFS/module_nst_model.f90 index f10bc5420..262a2bc1c 100644 --- a/physics/SFC_Layer/UFS/module_nst_model.f90 +++ b/physics/SFC_Layer/UFS/module_nst_model.f90 @@ -18,7 +18,7 @@ module nst_module use module_nst_parameters , only : eps_sfs, niter_z_w, niter_conv, niter_sfs, ri_c use module_nst_parameters , only : ri_g, omg_m, omg_sh, kw => tc_w, visw, t0k, cp_w use module_nst_parameters , only : z_c_max, z_c_ini, ustar_a_min, delz, exp_const - use module_nst_parameters , only : rad2deg, const_rot, tw_max, sst_max + use module_nst_parameters , only : const_rot, tw_max, sst_max use module_nst_parameters , only : zero, one use module_nst_water_prop , only : sw_rad_skin, sw_ps_9b, sw_ps_9b_aw @@ -34,13 +34,13 @@ module nst_module !>\ingroup gfs_nst_main_mod !! This subroutine contains the module of diurnal thermocline layer model. subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & - alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & + alpha,beta,alon,sinlat,soltim,grav,le,d_conv,con_pi, & xt,xs,xu,xv,xz,xzts,xtts) integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& hl_ts,rho,alpha,beta,alon,sinlat,soltim,& - grav,le,d_conv + grav,le,d_conv,con_pi real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts ! local variables @@ -86,7 +86,7 @@ subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! forward the system one time step ! call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & - beta,alon,sinlat,soltim,grav,le,d_conv, & + beta,alon,sinlat,soltim,grav,le,d_conv,con_pi, & xt,xs,xu,xv,xz,xzts,xtts) endif ! if ( xt == 0 ) then @@ -95,7 +95,7 @@ end subroutine dtm_1p !>\ingroup gfs_nst_main_mod !! This subroutine integrates one time step with modified Euler method. subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & - beta,alon,sinlat,soltim,grav,le,d_conv, & + beta,alon,sinlat,soltim,grav,le,d_conv,con_pi, & xt,xs,xu,xv,xz,xzts,xtts) ! @@ -104,7 +104,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & hl_ts,rho,alpha,beta,alon,sinlat,soltim, & - grav,le,d_conv + grav,le,d_conv,con_pi real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts ! local variables real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 @@ -113,6 +113,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 real(kind=kind_phys) :: dzw,drho,fc real(kind=kind_phys) :: alat,speed + real(kind=kind_phys) :: rad2deg ! logical lprnt ! @@ -157,6 +158,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, xzts0 = xzts speed = max(1.0e-8, xu0*xu0+xv0*xv0) + rad2deg = 180./con_pi alat = asin(sinlat)*rad2deg fc = const_rot*sinlat diff --git a/physics/SFC_Layer/UFS/module_nst_parameters.f90 b/physics/SFC_Layer/UFS/module_nst_parameters.f90 index 984335cc8..3e40ffe81 100644 --- a/physics/SFC_Layer/UFS/module_nst_parameters.f90 +++ b/physics/SFC_Layer/UFS/module_nst_parameters.f90 @@ -14,29 +14,16 @@ module module_nst_parameters use machine, only : kind_phys ! ! air constants and coefficients from the atmospehric model - use physcons, only: & - eps => con_eps & !< con_rd/con_rv (nd) - ,cp_a => con_cp & !< spec heat air @p (j/kg/k) - ,epsm1 => con_epsm1 & !< eps - 1 (nd) - ,hvap => con_hvap & !< lat heat h2o cond (j/kg) - ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) - ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) - ,omega => con_omega & !< ang vel of earth (1/s) - ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) - ,rd => con_rd & !< gas constant air (j/kg/k) - ,rocp => con_rocp & !< r/cp - ,pi => con_pi - implicit none private - public :: sigma_r + ! public :: sigma_r public :: zero, one, half public :: niter_conv, niter_z_w, niter_sfs public :: z_w_max, z_w_min, z_w_ini, z_c_max, z_c_ini, eps_z_w, eps_conv, eps_sfs public :: ri_c, ri_g, omg_m, omg_sh, tc_w, visw, cp_w, t0k, ustar_a_min, delz, exp_const - public :: rad2deg, const_rot, tw_max, sst_max, solar_time_6am, tau_min, wd_max + public :: const_rot, tw_max, sst_max, solar_time_6am, tau_min, wd_max real(kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, half = 0.5_kind_phys ! @@ -79,8 +66,6 @@ module module_nst_parameters ,novalue = 0 & ,smallnumber = 1.e-6 & ,timestep_oc = sec_in_day/8. & !< time step in the ocean model (3 hours) - ,radian = 2.*pi/180. & - ,rad2deg = 180./pi & ,cp_w = 4000. & !< specific heat water (j/kg/k ) ,rho0_w = 1022.0 & !< density water (kg/m3 ) (or 1024.438) ,vis_w = 1.e-6 & !< kinematic viscosity water (m2/s ) diff --git a/physics/SFC_Layer/UFS/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f index 4c019f433..fbd91ccaa 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -12,7 +12,7 @@ module sfc_diag !> @{ subroutine sfc_diag_run (im,xlat_d,xlon_d, & & lsm,lsm_ruc,grav,cp,eps,epsm1,con_rocp, & - & con_karman, & + & con_karman,con_t0c, & & shflx,cdq,wind, & & usfco,vsfco,use_oceanuv, & & zf,ps,u1,v1,t1,q1,prslki,evap,fm,fh,fm10,fh2, & @@ -24,7 +24,6 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! use machine , only : kind_phys, kind_dbl_prec use funcphys, only : fpvs - use physcons, only : con_t0c implicit none ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm @@ -34,7 +33,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics logical, intent(in) :: diag_log ! Flag for 2-m log diagnostics under stable conditions real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1,con_rocp - real(kind=kind_phys), intent(in) :: con_karman + real(kind=kind_phys), intent(in) :: con_karman, con_t0c real(kind=kind_phys), dimension(:), intent( in) :: & & zf, ps, u1, v1, t1, q1, ust, tskin, & & usfco, vsfco, & diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index 952d83c9c..349f6cbb3 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -2,7 +2,7 @@ name = sfc_diag type = scheme dependencies_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -93,6 +93,14 @@ type = real kind = kind_phys intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [zf] standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index d6b0e3383..2b5c7728a 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -7,8 +7,8 @@ module sfc_nst use machine , only : kind_phys, kp => kind_phys use funcphys , only : fpvs use module_nst_parameters , only : one, zero, half - use module_nst_parameters , only : t0k, cp_w, omg_m, omg_sh, sigma_r, solar_time_6am, sst_max - use module_nst_parameters , only : ri_c, z_w_max, delz, wd_max, rad2deg, const_rot, tau_min, tw_max + use module_nst_parameters , only : t0k, cp_w, omg_m, omg_sh, solar_time_6am, sst_max + use module_nst_parameters , only : ri_c, z_w_max, delz, wd_max, const_rot, tau_min, tw_max use module_nst_water_prop , only : get_dtzm_point, density, rhocoef, grv, sw_ps_9b use nst_module , only : cool_skin, dtm_1p, cal_w, cal_ttop, convdepth, dtm_1p_fca use nst_module , only : dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, dtl_reset @@ -244,6 +244,7 @@ subroutine sfc_nst_run & real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 real (kind=kind_phys) :: windrel + real (kind=kind_phys) :: rad2deg ! !====================================================================================================== ! Initialize CCPP error handling variables @@ -352,6 +353,7 @@ subroutine sfc_nst_run & ! zsea1 = 0.001_kp*real(nstf_name4) zsea2 = 0.001_kp*real(nstf_name5) + rad2deg = 180./pi !> - Call module_nst_water_prop::density() to compute sea water density. !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion @@ -449,7 +451,7 @@ subroutine sfc_nst_run & !> - Call the diurnal thermocline layer model dtm_1p(). call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), & f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, & - sinlat(i),soltim,grav,le,d_conv(i), & + sinlat(i),soltim,grav,le,d_conv(i),pi, & xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) ! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) diff --git a/physics/SFC_Models/Lake/Flake/flake_driver.F90 b/physics/SFC_Models/Lake/Flake/flake_driver.F90 index 9a51a7521..d12217ec6 100644 --- a/physics/SFC_Models/Lake/Flake/flake_driver.F90 +++ b/physics/SFC_Models/Lake/Flake/flake_driver.F90 @@ -42,10 +42,6 @@ SUBROUTINE flake_driver_run ( & ! use flake_parameters use machine , only : kind_phys ! use funcphys, only : fpvs -! use physcons, only : grav => con_g, cp => con_cp, & -! & hvap => con_hvap, rd => con_rd, & -! & eps => con_eps, epsm1 => con_epsm1, & -! & rvrdm1 => con_fvirt !============================================================================== diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f index 66b4caacd..b934a9beb 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.f +++ b/physics/SFC_Models/Land/Noah/lsm_noah.f @@ -221,7 +221,7 @@ subroutine lsm_noah_run & & bexppert, xlaipert, vegfpert,pertvegf, & ! sfc perts, mgehne & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & & adjvisbmd, adjnirbmd, adjvisdfd, adjnirdfd, rhonewsn1, & - & exticeden, & + & exticeden, con_csol, con_t0c, & ! --- in/outs: & weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & & canopy, trans, tsurf, zorl, & @@ -273,7 +273,7 @@ subroutine lsm_noah_run & logical, dimension(:), intent(in) :: flag_iter, flag_guess, land logical, intent(in) :: lheatstrg, exticeden - + real (kind=kind_phys), intent(in) :: con_csol, con_t0c ! --- in/out: real (kind=kind_phys), dimension(:), intent(inout) :: weasd, & & snwdph, tskin, tprcp, srflag, canopy, trans, tsurf, zorl @@ -286,8 +286,7 @@ subroutine lsm_noah_run & & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2 real (kind=kind_phys), dimension(:), intent(inout) :: lai, rca - real (kind=kind_phys), dimension(:), intent(inout), optional :: & - & wet1 + real (kind=kind_phys), intent(inout), optional :: wet1(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -535,6 +534,7 @@ subroutine lsm_noah_run & & vtype, stype, slope, shdmin1d, alb, snoalb1d, & & rhonewsn, exticeden, & & bexpp, xlaip, & ! sfc-perts, mgehne + & cp, con_csol, con_t0c, & & lheatstrg, & ! --- input/outputs: & tbot, cmc, tsea, stsoil, smsoil, slsoil, sneqv, chx, cmx, & @@ -583,7 +583,10 @@ subroutine lsm_noah_run & smc(i,k) = smsoil(k) slc(i,k) = slsoil(k) enddo - wet1(i) = smsoil(1) / smcmax !Sarah Lu added 09/09/2010 (for GOCART) + if (present(wet1)) then +! Sarah Lu added 09/09/2010 (for GOCART) + wet1(i) = smsoil(1) / smcmax + endif ! --- ... unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) runoff(i) = runoff1 * 1000.0_kind_phys diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index d523fa9fa..21234c8a1 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -502,6 +502,22 @@ dimensions = () type = logical intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land diff --git a/physics/SFC_Models/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f index efb2cb91a..cb3a486fe 100644 --- a/physics/SFC_Models/Land/Noah/sflx.f +++ b/physics/SFC_Models/Land/Noah/sflx.f @@ -120,6 +120,7 @@ subroutine gfssflx &! --- input & vegtyp, soiltyp, slopetyp, shdmin, alb, snoalb, & & rhonewsn, exticeden, & & bexpp, xlaip, & ! sfc-perts, mgehne + & con_cp, con_csol, con_t0c, & & lheatstrg, &! --- input/outputs: & tbot, cmc, t1, stc, smc, sh2o, sneqv, ch, cm,z0, &! --- outputs: & nroot, shdfac, snowh, albedo, eta, sheat, ec, & @@ -272,37 +273,27 @@ subroutine gfssflx &! --- input ! use machine , only : kind_phys ! - use physcons, only : con_cp, con_rd, con_t0c, con_g, con_pi, & - & con_cliq, con_csol, con_hvap, con_hfus, & - & con_sbc ! implicit none ! --- constant parameters: -! *** note: some of the constants are different in subprograms and need to -! be consolidated with the standard def in module physcons at sometime -! at the present time, those diverse values are kept temperately to -! provide the same result as the original codes. -- y.t.h. may09 integer, parameter :: nsold = 4 !< max soil layers ! real (kind=kind_phys), parameter :: gs = con_g !< con_g =9.80665 real (kind=kind_phys), parameter :: gs1 = 9.8 !< con_g in sfcdif real (kind=kind_phys), parameter :: gs2 = 9.81 !< con_g in snowpack, frh2o - real (kind=kind_phys), parameter :: tfreez = con_t0c !< con_t0c =273.16 real (kind=kind_phys), parameter :: lsubc = 2.501e+6 !< con_hvap=2.5000e+6 real (kind=kind_phys), parameter :: lsubf = 3.335e5 !< con_hfus=3.3358e+5 real (kind=kind_phys), parameter :: lsubs = 2.83e+6 ! ? in sflx, snopac real (kind=kind_phys), parameter :: elcp = 2.4888e+3 ! ? in penman ! real (kind=kind_phys), parameter :: rd = con_rd ! con_rd =287.05 real (kind=kind_phys), parameter :: rd1 = 287.04 ! con_rd in sflx, penman, canres - real (kind=kind_phys), parameter :: cp = con_cp ! con_cp =1004.6 real (kind=kind_phys), parameter :: cp1 = 1004.5 ! con_cp in sflx, canres real (kind=kind_phys), parameter :: cp2 = 1004.0 ! con_cp in htr ! real (kind=kind_phys), parameter :: cph2o = con_cliq ! con_cliq=4.1855e+3 real (kind=kind_phys), parameter :: cph2o1 = 4.218e+3 ! con_cliq in penman, snopac real (kind=kind_phys), parameter :: cph2o2 = 4.2e6 ! con_cliq in hrt *unit diff! - real (kind=kind_phys), parameter :: cpice = con_csol ! con_csol=2.106e+3 real (kind=kind_phys), parameter :: cpice1 = 2.106e6 ! con_csol in hrt *unit diff! ! real (kind=kind_phys), parameter :: sigma = con_sbc ! con_sbc=5.6704e-8 real (kind=kind_phys), parameter :: sigma1 = 5.67e-8 ! con_sbc in penman, nopac, snopac @@ -321,6 +312,7 @@ subroutine gfssflx &! --- input ! --- input/outputs: real (kind=kind_phys), intent(inout) :: tbot, cmc, t1, sneqv, & & stc(nsoil), smc(nsoil), sh2o(nsoil), ch, cm + real (kind=kind_phys), intent(in) :: con_cp, con_csol, con_t0c ! --- outputs: integer, intent(out) :: nroot @@ -345,6 +337,9 @@ subroutine gfssflx &! --- input real (kind=kind_phys) :: shdfac0 real (kind=kind_phys), dimension(nsold) :: rtdis, zsoil + real (kind=kind_phys) :: tfreez + real (kind=kind_phys) :: cp + real (kind=kind_phys) :: cpice logical :: frzgra, snowng @@ -357,6 +352,9 @@ subroutine gfssflx &! --- input errmsg = '' ! --- ... initialization + tfreez = con_t0c !< con_t0c =273.16 + cp = con_cp ! con_cp =1004.6 + cpice = con_csol ! con_csol=2.106e+3 runoff1 = 0.0 runoff2 = 0.0 diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 index 23a001a09..609fae2aa 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 @@ -9,9 +9,7 @@ module lsm_ruc use namelist_soilveg_ruc use set_soilveg_ruc_mod, only: set_soilveg_ruc use module_soil_pre - use module_sf_ruclsm - - use physcons, only : con_t0c + use module_sf_ruclsm, only: rslf, lsmruc, ruc_lsm_cons_init, ruclsminit implicit none @@ -47,7 +45,10 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & albdvis_lnd,albdnir_lnd,albivis_lnd,albinir_lnd, & ! out albdvis_ice,albdnir_ice,albivis_ice,albinir_ice, & ! out zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out - tsice, pores, resid, errmsg, errflg) + tsice, pores, resid, & ! out + rhowater, con_t0c, con_hfus, con_hvap, & ! in + con_pi, con_rv, con_g, con_csol, con_tice, & ! in + errmsg, errflg) implicit none ! --- in @@ -108,6 +109,18 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind_phys), dimension(:), intent(out) :: semisbase real (kind_phys), dimension(:), intent(out) :: pores, resid +! --- in + real (kind_phys), intent(in) :: rhowater + real (kind_phys), intent(in) :: con_t0c + real (kind_phys), intent(in) :: con_hfus + real (kind_phys), intent(in) :: con_hvap + real (kind_phys), intent(in) :: con_pi + real (kind_phys), intent(in) :: con_rv + real (kind_phys), intent(in) :: con_g + real (kind_phys), intent(in) :: con_csol + real (kind_phys), intent(in) :: con_tice + + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -144,6 +157,9 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & return end if + call ruc_lsm_cons_init(rhowater, con_t0c, con_hfus, con_hvap, & + con_pi, con_rv, con_g, con_csol, con_tice) + !> - Call rucinit() to initialize soil/ice/water variables if ( debug_print) then @@ -343,7 +359,7 @@ subroutine lsm_ruc_run & ! inputs & min_lakeice, min_seaice, oceanfrac, rhonewsn1, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & - & con_hfus, con_fvirt, stbolt, rhoh2o, & + & con_hfus, con_fvirt, con_t0c, stbolt, rhoh2o, & ! --- in/outs for ice and land & semisbase, semis_lnd, semis_ice, sfalb_lnd, sfalb_ice, & & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, & @@ -402,6 +418,7 @@ subroutine lsm_ruc_run & ! inputs con_pi, con_rd, & con_hvap, con_hfus, & con_fvirt, stbolt, rhoh2o + real (kind_phys), intent(in) :: con_t0c logical, dimension(:), intent(in) :: flag_iter, flag_guess logical, dimension(:), intent(in) :: land, icy diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta index a303cdaf4..4d0b3c8dd 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = ../../../hooks/machine.F,../../../hooks/physcons.F90 + dependencies = ../../../hooks/machine.F dependencies = module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## @@ -496,6 +496,78 @@ type = real intent = out kind = kind_phys +[rhowater] + standard_name = fresh_liquid_water_density_at_0c + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of vaporization/sublimation (hvap) + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_tice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1122,6 +1194,14 @@ type = real kind = kind_phys intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [stbolt] standard_name = stefan_boltzmann_constant long_name = Stefan-Boltzmann constant diff --git a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index 9b6a05717..b7d17177e 100644 --- a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -10,24 +10,25 @@ MODULE module_sf_ruclsm use machine , only : kind_phys, kind_dbl_prec use namelist_soilveg_ruc - use physcons, only : rhowater, con_t0c, con_hfus, con_hvap, & - con_pi, con_rv, con_g, con_csol, con_tice implicit none private !private qsn - public :: lsmruc, ruclsminit, rslf + public :: lsmruc, ruclsminit, rslf, ruc_lsm_cons_init + real (kind_phys) :: con_hfus = 1.0E30_kind_phys + real (kind_phys) :: rhowater = 1.0E30_kind_phys + real (kind_phys) :: con_tice = 1.0E30_kind_phys !> CONSTANT PARAMETERS !! @{ - real (kind_phys), parameter :: tfrz = con_t0c - real (kind_phys), parameter :: xls = con_hvap + con_hfus - real (kind_phys), parameter :: piconst = con_pi - real (kind_phys), parameter :: r_v = con_rv - real (kind_phys), parameter :: grav = con_g - real (kind_phys), parameter :: sheatice = con_csol + real (kind_phys) :: tfrz = 1.0E30_kind_phys + real (kind_phys) :: xls = 1.0E30_kind_phys + real (kind_phys) :: piconst = 1.0E30_kind_phys + real (kind_phys) :: r_v = 1.0E30_kind_phys + real (kind_phys) :: grav = 1.0E30_kind_phys + real (kind_phys) :: sheatice = 1.0E30_kind_phys real (kind_phys), parameter :: rhoice = 917._kind_phys ! ice density real (kind_phys), parameter :: sheatsn = 2090._kind_phys ! snow heat capacity @@ -79,6 +80,31 @@ MODULE module_sf_ruclsm CONTAINS + subroutine ruc_lsm_cons_init(rhowater_in, con_t0c, con_hfus_in, con_hvap, & + con_pi, con_rv, con_g, con_csol, con_tice_in ) + real (kind_phys), intent(in) :: rhowater_in + real (kind_phys), intent(in) :: con_t0c + real (kind_phys), intent(in) :: con_hfus_in + real (kind_phys), intent(in) :: con_hvap + real (kind_phys), intent(in) :: con_pi + real (kind_phys), intent(in) :: con_rv + real (kind_phys), intent(in) :: con_g + real (kind_phys), intent(in) :: con_csol + real (kind_phys), intent(in) :: con_tice_in + + ! set module level variables + con_hfus = con_hfus_in + rhowater = rhowater_in + con_tice = con_tice_in + tfrz = con_t0c + xls = con_hvap + con_hfus + piconst = con_pi + r_v = con_rv + grav = con_g + sheatice = con_csol + end subroutine ruc_lsm_cons_init + + !----------------------------------------------------------------- !>\ingroup lsm_ruc_group !> The RUN LSM model is described in Smirnova et al.(1997) diff --git a/physics/SFC_Models/Land/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 index 56aa06dda..1298aae72 100644 --- a/physics/SFC_Models/Land/sfc_land.F90 +++ b/physics/SFC_Models/Land/sfc_land.F90 @@ -78,7 +78,7 @@ subroutine sfc_land_run(im, flag_init, flag_restart, & real(kind=kind_phys), intent(in), optional :: cmm_lnd(:) real(kind=kind_phys), intent(in), optional :: chh_lnd(:) real(kind=kind_phys), intent(in), optional :: zvfun_lnd(:) - real(kind=kind_phys), intent(in), optional :: slc(:,:) + real(kind=kind_phys), intent(in) :: slc(:,:) ! Inputs/Outputs real(kind=kind_phys), intent(inout) :: sncovr1(:) real(kind=kind_phys), intent(inout) :: qsurf(:) diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.f b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f index 3147c0aa1..17d6f7507 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f @@ -16,8 +16,6 @@ module sfc_cice !! \htmlinclude sfc_cice_run.html !! -!! use physcons, only : hvap => con_hvap, cp => con_cp, & -!! & rvrdm1 => con_fvirt, rd => con_rd ! !----------------------------------- subroutine sfc_cice_run & diff --git a/physics/hooks/physcons.meta b/physics/hooks/physcons.meta index 9ce34376f..1e8fa5737 100644 --- a/physics/hooks/physcons.meta +++ b/physics/hooks/physcons.meta @@ -218,6 +218,111 @@ dimensions = () type = real kind = kind_phys +[rhoair_IFS] + standard_name = density_of_air_IFS + long_name = reference density of air used by IFS + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[rhosnow] + standard_name = density_of_snow + long_name = density of snow + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[visd] + standard_name = dynamic_viscosity_of_air + long_name = dynamic viscosity of air at 0 deg C and 1000 hPa + units = kg m-1 s-1 + dimensions = () + type = real + kind = kind_phys +[visk] + standard_name = kinematic_viscosity_of_air + long_name = kinematic viscosity of air at 0 deg C and 1000 hPa + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys +[vdifu] + standard_name = diffusivity_of_water_vapor_in_air + long_name = diffusivity of water vapor in air at 0 deg C and 1000 hPa + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys +[tcond] + standard_name = thermal_conductivity_of_air + long_name = thermal conductivity of air at 0 deg C and 1000 hPa + units = W m-1 K-1 + dimensions = () + type = real + kind = kind_phys +[cdg] + standard_name = drag_coefficient_of_graupel + long_name = drag coefficient of graupel + units = 1 + dimensions = () + type = real + kind = kind_phys +[cdh] + standard_name = drag_coefficient_of_hail + long_name = drag coefficient of hail + units = 1 + dimensions = () + type = real + kind = kind_phys +[rhocw] + standard_name = density_of_cloud_water + long_name = density of cloud water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[rhoci] + standard_name = density_of_cloud_ice + long_name = density of cloud ice + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[rhocr] + standard_name = density_of_rain + long_name = density of rain + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[rhocg] + standard_name = density_of_graupel + long_name = density of graupel + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[rhoch] + standard_name = density_of_hail + long_name = density of hail + units = kg m-3 + dimensions = () + type = real + kind = kind_phys +[qcmin] + standard_name = minimum_mass_mixing_ratio_of_cloud_condensate + long_name = minimum value for cloud condensates + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys +[qfmin] + standard_name = minimum_mass_mixing_ratio_for_sedimentation + long_name = minimum value for sedimentation + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys [con_csol] standard_name = specific_heat_of_ice_at_constant_pressure long_name = specific heat of ice at constant pressure @@ -316,6 +421,13 @@ dimensions = () type = real kind = kind_phys +[con_amo3] + standard_name = molecular_weight_of_ozone + long_name = molecular weight of ozone + units = g mol-1 + dimensions = () + type = real + kind = kind_phys [con_one] standard_name = constant_one long_name = mathematical constant of one diff --git a/physics/photochem/module_ozphys.F90 b/physics/photochem/module_ozphys.F90 index bf64f0591..489d77d81 100644 --- a/physics/photochem/module_ozphys.F90 +++ b/physics/photochem/module_ozphys.F90 @@ -36,7 +36,6 @@ ! ######################################################################################### module module_ozphys use machine, only : kind_phys - use funcphys, only : fpkapx implicit none public ty_ozphys @@ -511,10 +510,11 @@ subroutine run_o3clim(this, lat, prslk, con_pi, oz) end subroutine run_o3clim !> Procedure (type-bound) for loading data for climotological ozone. - function load_o3clim(this, file, fileID) result (err_message) + function load_o3clim(this, file, fileID, con_rocp) result (err_message) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: fileID character(len=*), intent(in) :: file + real(kind_phys), intent(in) :: con_rocp character(len=128) :: err_message ! Locals @@ -589,7 +589,8 @@ function load_o3clim(this, file, fileID) result (err_message) do iLev = 1, this%nlevc this%pstr(iLev) = pstr4(iLev) - this%pkstr(iLev) = fpkapx(this%pstr(iLev)*100.0) + ! following line equivalent to funcphys's fpkapx=(p/1.e5_krealfp)**con_rocp + this%pkstr(iLev) = (this%pstr(iLev)*1.0e-3_kind_phys)**con_rocp enddo end function load_o3clim diff --git a/physics/photochem/module_ozphys.meta b/physics/photochem/module_ozphys.meta index 2922d16d7..fb7c58094 100644 --- a/physics/photochem/module_ozphys.meta +++ b/physics/photochem/module_ozphys.meta @@ -11,7 +11,7 @@ [ccpp-table-properties] name = module_ozphys type = module - dependencies = machine.F,funcphys.f90 + dependencies = machine.F [ccpp-arg-table] name = module_ozphys diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 34b1e762d..cf645082a 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -119,7 +119,7 @@ subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & nsoil, smc, tslb, vegtype_dom, vegtype_frac, soiltyp, nlcat, & dswsfc, zorl, snow, julian, recmol, & - idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & + idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & ntfsmoke, ntsmoke, ntdust, ntcoarsepm, & @@ -139,7 +139,7 @@ subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land integer, intent(in) :: im,kte,kme,ktau,nsoil,tile_num,jdate(8),idat(8) integer, intent(in) :: ntrac, ntfsmoke, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat logical, intent(in) :: flag_init - real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd, con_fv + real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd integer, parameter :: ids=1,jds=1,jde=1, kds=1 integer, parameter :: ims=1,jms=1,jme=1, kms=1 @@ -328,7 +328,7 @@ subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land !>- get ready for chemistry run call rrfs_smoke_prep( & - ktau,current_month, current_hour, gmt, con_rd, con_fv, con_cp, & + ktau,current_month, current_hour, gmt, con_rd, con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,tslb,vegtype_dom,soiltyp, & @@ -658,7 +658,7 @@ subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land end subroutine rrfs_smoke_wrapper_run subroutine rrfs_smoke_prep( & - ktau,current_month,current_hour,gmt,con_rd,con_fv,con_cp, & + ktau,current_month,current_hour,gmt,con_rd,con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,tslb,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & @@ -687,7 +687,7 @@ subroutine rrfs_smoke_prep( & integer, intent(in) :: nsoil, ktau integer, dimension(ims:ime), intent(in) :: land, vegtype_dom, soiltyp integer, intent(in) :: ntrac - real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv, con_cp + real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_cp real(kind=kind_phys), dimension(ims:ime), intent(in) :: & u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol, & @@ -886,7 +886,7 @@ subroutine rrfs_smoke_prep( & wind_phy(i,k,j) = sqrt(u_phy(i,k,j)**2 + v_phy(i,k,j)**2) ! from mp_thompson.F90 ; rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) ! from mynnd - rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) !*(1.+con_fv*spechum(i,kkp))) + rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) rri(i,k,j)=1./rho_phy(i,k,j) vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index d4c8ac256..564189be4 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -582,14 +582,6 @@ type = real kind = kind_phys intent = in -[con_fv] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in [dust12m_in] standard_name = fengsha_dust12m_input long_name = fengsha dust input diff --git a/physics/tools/funcphys.f90 b/physics/tools/funcphys.f90 index 3e81a0d5a..13db80d06 100644 --- a/physics/tools/funcphys.f90 +++ b/physics/tools/funcphys.f90 @@ -261,7 +261,6 @@ module funcphys ! !$$$ use machine,only:kind_phys,r8=>kind_dbl_prec,r4=>kind_sngl_prec - use physcons implicit none private ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -270,7 +269,29 @@ module funcphys integer,public,parameter:: krealfp=kind_phys !< Integer parameter kind or length of reals ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Private Variables - real(krealfp),parameter:: psatb=con_psat*1.e-5 + real(krealfp) :: con_rd = 1.0e30_krealfp + real(krealfp) :: con_rv = 1.0e30_krealfp + real(krealfp) :: con_cp = 1.0e30_krealfp + real(krealfp) :: con_cvap = 1.0e30_krealfp + real(krealfp) :: con_cliq = 1.0e30_krealfp + real(krealfp) :: con_csol = 1.0e30_krealfp + real(krealfp) :: con_hvap = 1.0e30_krealfp + real(krealfp) :: con_hfus = 1.0e30_krealfp + real(krealfp) :: con_psat = 1.0e30_krealfp + real(krealfp) :: con_ttp = 1.0e30_krealfp + real(krealfp) :: con_rocp = 1.0e30_krealfp + real(krealfp) :: con_cpor = 1.0e30_krealfp + real(krealfp) :: con_eps = 1.0e30_krealfp + real(krealfp) :: con_dldt = 1.0e30_krealfp + real(krealfp) :: con_xpona = 1.0e30_krealfp + real(krealfp) :: con_xponb = 1.0e30_krealfp + real(krealfp) :: dldti = 1.0e30_krealfp + real(krealfp) :: heati = 1.0e30_krealfp + real(krealfp) :: xponai = 1.0e30_krealfp + real(krealfp) :: xponbi = 1.0e30_krealfp + real(krealfp) :: tliq = 1.0e30_krealfp + real(krealfp) :: tice = 1.0e30_krealfp + real(krealfp) :: psatb = 1.0e30_krealfp integer,parameter:: nxpvsl=7501 real(krealfp) c1xpvsl,c2xpvsl,tbpvsl(nxpvsl) integer,parameter:: nxpvsi=7501 @@ -563,14 +584,10 @@ elemental function fpvslx(t) implicit none real(krealfp) fpvslx real(krealfp),intent(in):: t - real(krealfp),parameter:: dldt=con_cvap-con_cliq - real(krealfp),parameter:: heat=con_hvap - real(krealfp),parameter:: xpona=-dldt/con_rv - real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp) real(krealfp) tr ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tr=con_ttp/t - fpvslx=con_psat*(tr**xpona)*exp(xponb*(1.-tr)) + fpvslx=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end function !------------------------------------------------------------------------------- @@ -822,14 +839,10 @@ elemental function fpvsix(t) implicit none real(krealfp) fpvsix real(krealfp),intent(in):: t - real(krealfp),parameter:: dldt=con_cvap-con_csol - real(krealfp),parameter:: heat=con_hvap+con_hfus - real(krealfp),parameter:: xpona=-dldt/con_rv - real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp) real(krealfp) tr ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tr=con_ttp/t - fpvsix=con_psat*(tr**xpona)*exp(xponb*(1.-tr)) + fpvsix=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end function !------------------------------------------------------------------------------- @@ -1047,26 +1060,16 @@ elemental function fpvsx(t) implicit none real(krealfp) fpvsx real(krealfp),intent(in):: t - real(krealfp),parameter:: tliq=con_ttp - real(krealfp),parameter:: tice=con_ttp-20.0 - real(krealfp),parameter:: dldtl=con_cvap-con_cliq - real(krealfp),parameter:: heatl=con_hvap - real(krealfp),parameter:: xponal=-dldtl/con_rv - real(krealfp),parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp) - real(krealfp),parameter:: dldti=con_cvap-con_csol - real(krealfp),parameter:: heati=con_hvap+con_hfus - real(krealfp),parameter:: xponai=-dldti/con_rv - real(krealfp),parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp) real(krealfp) tr,w,pvl,pvi ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - tr=con_ttp/t if(t.ge.tliq) then - fpvsx=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) + fpvsx=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) elseif(t.lt.tice) then fpvsx=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) else w=(t-tice)/(tliq-tice) - pvl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) + pvl=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) pvi=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) fpvsx=w*pvl+(1.-w)*pvi endif @@ -1335,18 +1338,14 @@ elemental function ftdplxg(tg,pv) real(krealfp) ftdplxg real(krealfp),intent(in):: tg,pv real(krealfp),parameter:: terrm=1.e-6 - real(krealfp),parameter:: dldt=con_cvap-con_cliq - real(krealfp),parameter:: heat=con_hvap - real(krealfp),parameter:: xpona=-dldt/con_rv - real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp) real(krealfp) t,tr,pvt,el,dpvt,terr integer i ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - t=tg do i=1,100 tr=con_ttp/t - pvt=con_psat*(tr**xpona)*exp(xponb*(1.-tr)) - el=heat+dldt*(t-con_ttp) + pvt=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) + el=con_hvap+con_dldt*(t-con_ttp) dpvt=el*pvt/(con_rv*t**2) terr=(pvt-pv)/dpvt t=t-terr @@ -1625,18 +1624,14 @@ elemental function ftdpixg(tg,pv) real(krealfp) ftdpixg real(krealfp),intent(in):: tg,pv real(krealfp),parameter:: terrm=1.e-6 - real(krealfp),parameter:: dldt=con_cvap-con_csol - real(krealfp),parameter:: heat=con_hvap+con_hfus - real(krealfp),parameter:: xpona=-dldt/con_rv - real(krealfp),parameter:: xponb=-dldt/con_rv+heat/(con_rv*con_ttp) real(krealfp) t,tr,pvt,el,dpvt,terr integer i ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - t=tg do i=1,100 tr=con_ttp/t - pvt=con_psat*(tr**xpona)*exp(xponb*(1.-tr)) - el=heat+dldt*(t-con_ttp) + pvt=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) + el=heati+dldti*(t-con_ttp) dpvt=el*pvt/(con_rv*t**2) terr=(pvt-pv)/dpvt t=t-terr @@ -1925,16 +1920,6 @@ elemental function ftdpxg(tg,pv) real(krealfp) ftdpxg real(krealfp),intent(in):: tg,pv real(krealfp),parameter:: terrm=1.e-6 - real(krealfp),parameter:: tliq=con_ttp - real(krealfp),parameter:: tice=con_ttp-20.0 - real(krealfp),parameter:: dldtl=con_cvap-con_cliq - real(krealfp),parameter:: heatl=con_hvap - real(krealfp),parameter:: xponal=-dldtl/con_rv - real(krealfp),parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp) - real(krealfp),parameter:: dldti=con_cvap-con_csol - real(krealfp),parameter:: heati=con_hvap+con_hfus - real(krealfp),parameter:: xponai=-dldti/con_rv - real(krealfp),parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp) real(krealfp) t,tr,w,pvtl,pvti,pvt,ell,eli,el,dpvt,terr integer i ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1942,8 +1927,8 @@ elemental function ftdpxg(tg,pv) do i=1,100 tr=con_ttp/t if(t.ge.tliq) then - pvt=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) - el=heatl+dldtl*(t-con_ttp) + pvt=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) + el=con_hvap+con_dldt*(t-con_ttp) dpvt=el*pvt/(con_rv*t**2) elseif(t.lt.tice) then pvt=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) @@ -1951,10 +1936,10 @@ elemental function ftdpxg(tg,pv) dpvt=el*pvt/(con_rv*t**2) else w=(t-tice)/(tliq-tice) - pvtl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr)) + pvtl=con_psat*(tr**con_xpona)*exp(con_xponb*(1.-tr)) pvti=con_psat*(tr**xponai)*exp(xponbi*(1.-tr)) pvt=w*pvtl+(1.-w)*pvti - ell=heatl+dldtl*(t-con_ttp) + ell=con_hvap+con_dldt*(t-con_ttp) eli=heati+dldti*(t-con_ttp) dpvt=(w*ell*pvtl+(1.-w)*eli*pvti)/(con_rv*t**2) endif @@ -3390,7 +3375,8 @@ elemental function ftlclx(t,tdpd) !! set up for computing saturation vapor pressure, dewpoint temperature, !! equivalent potential temperature, moist adiabatic temperature and humidity, !! pressure to the kappa, and lifting condensation level temperature. - subroutine gfuncphys + subroutine gfuncphys(con_rd_in, con_rv_in, con_cp_in, con_cvap_in, con_cliq_in, & + con_csol_in, con_hvap_in, con_hfus_in, con_psat_in, con_ttp_in) !$$$ Subprogram Documentation Block ! ! Subprogram: gfuncphys Compute all physics function tables @@ -3424,7 +3410,37 @@ subroutine gfuncphys ! !$$$ implicit none -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + real(krealfp), intent(in) :: con_rd_in, con_rv_in, con_cp_in + real(krealfp), intent(in) :: con_cvap_in, con_cliq_in, con_csol_in + real(krealfp), intent(in) :: con_hvap_in, con_hfus_in + real(krealfp), intent(in) :: con_psat_in, con_ttp_in +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + con_rd = con_rd_in + con_rv = con_rv_in + con_cp = con_cp_in + con_cvap = con_cvap_in + con_cliq = con_cliq_in + con_csol = con_csol_in + con_hvap = con_hvap_in + con_hfus = con_hfus_in + con_psat = con_psat_in + con_ttp = con_ttp_in + + con_rocp = con_rd/con_cp + con_cpor = con_cp/con_rd + con_eps = con_rd/con_rv + con_dldt = con_cvap-con_cliq + con_xpona = -con_dldt/con_rv + con_xponb = con_xpona+con_hvap/(con_rv*con_ttp) + + dldti = con_cvap-con_csol + heati = con_hvap+con_hfus + xponai = -dldti/con_rv + xponbi = xponai+heati/(con_rv*con_ttp) + tliq = con_ttp + tice = con_ttp-20.0_krealfp + psatb = con_psat*1.0e-5_krealfp + call gpvsl call gpvsi call gpvs diff --git a/physics/tools/get_phi_fv3.F90 b/physics/tools/get_phi_fv3.F90 index d111d3ae0..213d40b00 100644 --- a/physics/tools/get_phi_fv3.F90 +++ b/physics/tools/get_phi_fv3.F90 @@ -4,7 +4,6 @@ module get_phi_fv3 use machine, only: kind_phys - use physcons, only: con_fvirt !--- public declarations public get_phi_fv3_run diff --git a/physics/tools/get_phi_fv3.meta b/physics/tools/get_phi_fv3.meta index 45af05007..3b8500cfd 100644 --- a/physics/tools/get_phi_fv3.meta +++ b/physics/tools/get_phi_fv3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = get_phi_fv3 type = scheme - dependencies = ../hooks/machine.F,../hooks/physcons.F90 + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table]