diff --git a/physics/GFS_rrtmgp_post.meta b/physics/GFS_rrtmgp_post.meta index e4bc3e5dc..2de2397a9 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/GFS_rrtmgp_post.meta @@ -2,6 +2,7 @@ name = GFS_rrtmgp_post type = scheme dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 009eb8c38..13ff6a2df 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -364,8 +364,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl vmr_co2 = gas_vmr(:,:,1) ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. - vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) - vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) + vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0.0_kind_phys, q_lay .ne. 1.) + vmr_o3 = merge(o3_lay*amdo3, 0.0_kind_phys, o3_lay .gt. 0.) ! ####################################################################################### ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) diff --git a/physics/GFS_suite_interstitial_3.F90 b/physics/GFS_suite_interstitial_3.F90 index ca82f20aa..efb325c3f 100644 --- a/physics/GFS_suite_interstitial_3.F90 +++ b/physics/GFS_suite_interstitial_3.F90 @@ -44,7 +44,7 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & integer, intent(in) :: ntinc, ntlnc logical, intent(in) :: ldiag3d, qdiag3d integer, dimension(:,:), intent(in) :: dtidx - real, dimension(:,:), intent(out) :: save_lnc, save_inc + real(kind=kind_phys), dimension(:,:), intent(out) :: save_lnc, save_inc real(kind=kind_phys), intent(in ) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), intent(in ), dimension(:) :: work1, work2 diff --git a/physics/cires_orowam2017.f b/physics/cires_orowam2017.f index 9f04ac3b0..f43651898 100644 --- a/physics/cires_orowam2017.f +++ b/physics/cires_orowam2017.f @@ -64,28 +64,28 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, real(kind=kind_phys), parameter :: hps =7000., rhp2 = .5/hps real(kind=kind_phys), parameter :: cxmin=0.5, cxmin2=cxmin*cxmin - real :: akx(nworo), cxoro(nworo), akx2(nworo) - real :: aspkx(nworo), c2f2(nworo) , cdf2(nworo) - real :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) - real :: tau_kx(nworo),taub_kx(nworo) - real, dimension(nworo, levs+1) :: wrms, akzw - - real :: tauz(levs+1), rms_wind(levs+1) - real :: wave_act(nworo,levs+1) - - real :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint - real :: rayf, kturb - real :: uz, bv, bv2,kxsp, fcor2, cf2 - - real :: fdis - real :: wfdm, wfdt, wfim, wfit - real :: betadis, betam, betat, kds, cx, rhofac - real :: etwk, etws, tauk, cx2sat - real :: cdf1, tau_norm + real(kind_phys) :: akx(nworo), cxoro(nworo), akx2(nworo) + real(kind_phys) :: aspkx(nworo), c2f2(nworo) , cdf2(nworo) + real(kind_phys) :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) + real(kind_phys) :: tau_kx(nworo),taub_kx(nworo) + real(kind_phys), dimension(nworo, levs+1) :: wrms, akzw + + real(kind_phys) :: tauz(levs+1), rms_wind(levs+1) + real(kind_phys) :: wave_act(nworo,levs+1) + + real(kind_phys) :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint + real(kind_phys) :: rayf, kturb + real(kind_phys) :: uz, bv, bv2,kxsp, fcor2, cf2 + + real(kind_phys) :: fdis + real(kind_phys) :: wfdm, wfdt, wfim, wfit + real(kind_phys) :: betadis, betam, betat, kds, cx, rhofac + real(kind_phys) :: etwk, etws, tauk, cx2sat + real(kind_phys) :: cdf1, tau_norm ! ! mean flow ! - real, dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi + real(kind_phys), dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi integer :: nw, nzi, ksrc taud (:, :) = 0.0 ; pkdis(:,:) = 0.0 ; taup (:,:) = 0.0 @@ -286,29 +286,31 @@ end subroutine oro_wam_2017 subroutine oro_meanflow_v0(nz, nzi, u1, v1, t1, pint, pmid, & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) + use machine, only: kind_phys use ugwp_common_v0 , only : grav, rgrav, rdi, velmin, dw2min implicit none integer :: nz, nzi - real, dimension(nz ) :: u1, v1, t1, delp, rho, pmid - real, dimension(nz ) :: bn2 ! define at the interfaces - real, dimension(nz+1) :: pint - real :: xn, yn + real(kind_phys), dimension(nz ) :: u1, v1, t1, delp, rho, pmid + real(kind_phys), dimension(nz ) :: bn2 ! define at the interfaces + real(kind_phys), dimension(nz+1) :: pint + real(kind_phys) :: xn, yn ! output - real, dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp + real(kind_phys), dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp ! locals integer :: i, j, k - real :: ui, vi, ti, uz, vz, shr2, rdz, kamp - real :: zgrow, zmet, rdpm, ritur, kmol, w1 + real(kind_phys) :: ui, vi, ti, uz, vz, shr2, rdz, kamp + real(kind_phys) :: zgrow, zmet, rdpm, ritur, kmol, w1 ! paremeters - real, parameter :: hps = 7000., rpspa = 1.e-5 - real, parameter :: rhps=1.0/hps - real, parameter :: h4= 0.25/hps - real, parameter :: rimin = 1.0/8.0, kedmin = 0.01 - real, parameter :: lturb = 30. , uturb = 150.0 - real, parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb + real(kind_phys), parameter :: hps = 7000., rpspa = 1.e-5 + real(kind_phys), parameter :: rhps=1.0/hps + real(kind_phys), parameter :: h4= 0.25/hps + real(kind_phys), parameter :: rimin = 1.0/8.0, kedmin = 0.01 + real(kind_phys), parameter :: lturb = 30. , uturb = 150.0 + real(kind_phys), parameter :: lsc2 = lturb*lturb + real(kind_phys), parameter :: usc2 = uturb*uturb kalp(1:nzi) = 2.e-7 ! radiative damping do k=2, nz @@ -323,7 +325,7 @@ subroutine oro_meanflow_v0(nz, nzi, u1, v1, t1, pint, pmid, uz = u1(k)-u1(k-1) vz = v1(k)-v1(k-1) shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) - zmet = -hps*alog(pint(k)*rpspa) + zmet = -hps*log(pint(k)*rpspa) zgrow = exp(zmet*h4) kmol = 2.e-5*exp(zmet*rhps)+kedmin ritur = max(bn2(k)/shr2, rimin) diff --git a/physics/cires_ugwp_initialize.F90 b/physics/cires_ugwp_initialize.F90 index ddcbdadf7..8c2b5b840 100644 --- a/physics/cires_ugwp_initialize.F90 +++ b/physics/cires_ugwp_initialize.F90 @@ -35,32 +35,33 @@ end module ugwp_common_v0 !=================================================== !> Initialization of wave dissipation and RFriction subroutine init_global_gwdis_v0(levs, zkm, pmb, kvg, ktg, krad, kion) + use machine, only: kind_phys implicit none - integer :: levs - real, intent(in) :: zkm(levs), pmb(levs) - real, intent(out), dimension(levs+1) :: kvg, ktg, krad, kion + integer :: levs + real(kind_phys), intent(in) :: zkm(levs), pmb(levs) + real(kind_phys), intent(out), dimension(levs+1) :: kvg, ktg, krad, kion ! !locals + data ! integer :: k - real, parameter :: vusurf = 2.e-5 - real, parameter :: musurf = vusurf/1.95 - real, parameter :: hpmol = 8.5 + real(kind_phys), parameter :: vusurf = 2.e-5 + real(kind_phys), parameter :: musurf = vusurf/1.95 + real(kind_phys), parameter :: hpmol = 8.5 ! - real, parameter :: kzmin = 0.1 - real, parameter :: kturbo = 100. - real, parameter :: zturbo = 130. - real, parameter :: zturw = 30. - real, parameter :: inv_pra = 3. !kt/kv =inv_pr + real(kind_phys), parameter :: kzmin = 0.1 + real(kind_phys), parameter :: kturbo = 100. + real(kind_phys), parameter :: zturbo = 130. + real(kind_phys), parameter :: zturw = 30. + real(kind_phys), parameter :: inv_pra = 3. !kt/kv =inv_pr ! - real, parameter :: alpha = 1./86400./15. + real(kind_phys), parameter :: alpha = 1./86400./15. ! - real, parameter :: kdrag = 1./86400./10. - real, parameter :: zdrag = 100. - real, parameter :: zgrow = 50. + real(kind_phys), parameter :: kdrag = 1./86400./10. + real(kind_phys), parameter :: zdrag = 100. + real(kind_phys), parameter :: zgrow = 50. ! - real :: vumol, mumol, keddy, ion_drag + real(kind_phys) :: vumol, mumol, keddy, ion_drag ! do k=1, levs vumol = vusurf*exp(-zkm(k)/hpmol) @@ -97,6 +98,7 @@ end subroutine init_global_gwdis_v0 !========================================================================= module ugwpv0_oro_init + use machine, only: kind_phys use ugwp_common_v0, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi implicit none @@ -107,68 +109,68 @@ module ugwpv0_oro_init ! character(len=8) :: strver = 'gfs_2018' character(len=8) :: strbase = 'gfs_2018' - real, parameter :: rimin=-10., ric=0.25 + real(kind_phys), parameter :: rimin=-10., ric=0.25 ! - real, parameter :: efmin=0.5, efmax=10.0 - real, parameter :: hpmax=2400.0, hpmin=25.0 - real, parameter :: sigma_std=1./100., gamm_std=1.0 + real(kind_phys), parameter :: efmin=0.5, efmax=10.0 + real(kind_phys), parameter :: hpmax=2400.0, hpmin=25.0 + real(kind_phys), parameter :: sigma_std=1./100., gamm_std=1.0 - real, parameter :: frmax=10., frc =1.0, frmin =0.01 + real(kind_phys), parameter :: frmax=10., frc =1.0, frmin =0.01 ! - real, parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 - real, parameter :: gmax=1.0, veleps=1.0, factop=0.5 + real(kind_phys), parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 + real(kind_phys), parameter :: gmax=1.0, veleps=1.0, factop=0.5 ! - real, parameter :: rlolev=50000.0 + real(kind_phys), parameter :: rlolev=50000.0 ! - real, parameter :: hncrit=9000. ! max value in meters for elvmax + real(kind_phys), parameter :: hncrit=9000. ! max value in meters for elvmax ! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt - real, parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor - real, parameter :: hminmt=50. ! min mtn height (*j*) - real, parameter :: minwnd=1.0 ! min wind component (*j*) - real, parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa + real(kind_phys), parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor + real(kind_phys), parameter :: hminmt=50. ! min mtn height (*j*) + real(kind_phys), parameter :: minwnd=1.0 ! min wind component (*j*) + real(kind_phys), parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa - real, parameter :: kxoro=6.28e-3/200. ! - real, parameter :: coro = 0.0 + real(kind_phys), parameter :: kxoro=6.28e-3/200. ! + real(kind_phys), parameter :: coro = 0.0 integer, parameter :: nridge=2 - real :: cdmb ! scale factors for mtb - real :: cleff ! scale factors for orogw + real(kind_phys) :: cdmb ! scale factors for mtb + real(kind_phys) :: cleff ! scale factors for orogw integer :: nworo ! number of waves integer :: nazoro ! number of azimuths integer :: nstoro ! flag for stochastic launch above SG-peak integer, parameter :: mdir = 8 - real, parameter :: fdir=.5*mdir/pi + real(kind_phys), parameter :: fdir=.5*mdir/pi integer nwdir(mdir) data nwdir/6,7,5,8,2,3,1,4/ save nwdir - real, parameter :: odmin = 0.1, odmax = 10.0 + real(kind_phys), parameter :: odmin = 0.1, odmax = 10.0 !------------------------------------------------------------------------------ ! small-scale orography parameters for TOFD of Beljaars et al., 2004, QJRMS !------------------------------------------------------------------------------ - integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl - real, parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - real, parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters - real, parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] - real, parameter :: ztop_tofd = 10.*ze_tofd ! no TOFD > this height too higher 15 km + integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl + real(kind_phys), parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + real(kind_phys), parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters + real(kind_phys), parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] + real(kind_phys), parameter :: ztop_tofd = 10.*ze_tofd ! no TOFD > this height too higher 15 km !------------------------------------------------------------------------------ ! - real, parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm - real, parameter :: fcrit_gfs = 0.7 - real, parameter :: fcrit_mtb = 0.7 + real(kind_phys), parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm + real(kind_phys), parameter :: fcrit_gfs = 0.7 + real(kind_phys), parameter :: fcrit_mtb = 0.7 - 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(kind_phys), parameter :: lzmax = 18.e3 ! 18 km + real(kind_phys), parameter :: mkzmin = 6.28/lzmax + real(kind_phys), parameter :: mkz2min = mkzmin*mkzmin + real(kind_phys), parameter :: zbr_pi = (3.0/2.0)*pi + real(kind_phys), parameter :: zbr_ifs = 0.5*pi contains ! @@ -178,17 +180,17 @@ subroutine init_oro_gws_v0(nwaves, nazdir, nstoch, effac, & ! integer :: nwaves, nazdir, nstoch integer :: lonr - real :: cdmbgwd(2) ! scaling factors for MTb (1) & (2) for cleff = cleff * cdmbgwd(2) + real(kind_phys) :: cdmbgwd(2) ! scaling factors for MTb (1) & (2) for cleff = cleff * cdmbgwd(2) ! high res-n "larger" MTB and "less-active" cleff in GFS-2018 - real :: cdmbX - real :: kxw - real :: effac ! it is analog of cdmbgwd(2) for GWs, off for now + real(kind_phys) :: cdmbX + real(kind_phys) :: kxw + real(kind_phys) :: effac ! it is analog of cdmbgwd(2) for GWs, off for now !-----------------------------! GFS-setup for cdmb & cleff ! cdmb = 4.0 * (192.0/IMX) ! cleff = 0.5E-5 / SQRT(IMX/192.0) = 0.5E-5*SQRT(192./IMX) ! - real, parameter :: lonr_refmb = 4.0 * 192.0 - real, parameter :: lonr_refgw = 192.0 + real(kind_phys), parameter :: lonr_refmb = 4.0 * 192.0 + real(kind_phys), parameter :: lonr_refgw = 192.0 ! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch @@ -226,11 +228,12 @@ end module ugwpv0_oro_init !=============================== module ugwpv0_lsatdis_init + use machine, only: kind_phys implicit none integer :: nwav, nazd integer :: nst - real :: eff + real(kind_phys) :: eff integer, parameter :: incdim = 4, iazdim = 4 ! contains @@ -242,9 +245,9 @@ subroutine initsolv_lsatdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_ph integer :: me, master integer :: nwaves, nazdir integer :: nstoch - real :: effac + real(kind_phys) :: effac logical :: do_physb - real :: kxw + real(kind_phys) :: kxw ! !locals: define azimuths and Ch(nwaves) - domain when physics-based soureces ! are not actibve @@ -272,50 +275,51 @@ end module ugwpv0_lsatdis_init ! module ugwpv0_wmsdis_init + use machine, only: kind_phys use ugwp_common_v0, only : pi, pi2 implicit none - real, parameter :: maxdudt = 250.e-5 + real(kind_phys), parameter :: maxdudt = 250.e-5 - real, parameter :: hpscale= 7000., rhp2 = 0.5/hpscale - real, parameter :: omega2 = 2.*6.28/86400 - real, parameter :: gptwo=2.0 + real(kind_phys), parameter :: hpscale= 7000., rhp2 = 0.5/hpscale + real(kind_phys), parameter :: omega2 = 2.*6.28/86400 + real(kind_phys), parameter :: gptwo=2.0 - real, parameter :: dked_min =0.01 - real, parameter :: gssec = (6.28/30.)**2 ! max-value for bn2 - real, parameter :: bv2min = (6.28/60./120.)**2 ! min-value for bn2 7.6(-7) 2 hrs - real, parameter :: minvel = 0.5 + real(kind_phys), parameter :: dked_min =0.01 + real(kind_phys), parameter :: gssec = (6.28/30.)**2 ! max-value for bn2 + real(kind_phys), parameter :: bv2min = (6.28/60./120.)**2 ! min-value for bn2 7.6(-7) 2 hrs + real(kind_phys), parameter :: minvel = 0.5 ! ! make parameter list that will be passed to SOLVER ! - real, parameter :: v_kxw = 6.28e-3/200. - real, parameter :: v_kxw2 = v_kxw*v_kxw - real, parameter :: tamp_mpa = 30.e-3 - real, parameter :: zfluxglob= 3.75e-3 + real(kind_phys), parameter :: v_kxw = 6.28e-3/200. + real(kind_phys), parameter :: v_kxw2 = v_kxw*v_kxw + real(kind_phys), parameter :: tamp_mpa = 30.e-3 + real(kind_phys), parameter :: zfluxglob= 3.75e-3 - real , parameter :: nslope=1 ! the GW sprctral slope at small-m + real(kind_phys) , parameter :: nslope=1 ! the GW sprctral slope at small-m integer , parameter :: iazidim=4 ! number of azimuths integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum - real , parameter :: ucrit2=0.5 + real(kind_phys) , parameter :: ucrit2=0.5 - 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(kind_phys) , parameter :: zcimin = ucrit2 + real(kind_phys) , parameter :: zcimax = 125.0 + real(kind_phys) , parameter :: zgam = 0.25 + real(kind_phys) , parameter :: zms_l = 2000.0, zms = pi2 / zms_l, zmsi = 1.0 / zms integer :: ilaunch - real :: gw_eff + real(kind_phys) :: gw_eff !=========================================================================== integer :: nwav, nazd, nst - real :: eff + real(kind_phys) :: eff - real :: zaz_fct - real, allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) - real, allocatable :: zcosang(:), zsinang(:) + real(kind_phys) :: zaz_fct + real(kind_phys), allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) + real(kind_phys), allocatable :: zcosang(:), zsinang(:) contains !============================================================================ subroutine initsolv_wmsdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) @@ -327,15 +331,15 @@ subroutine initsolv_wmsdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_phy ! ! integer :: me, master, nwaves, nazdir, nstoch - real :: effac, kxw + real(kind_phys) :: effac, kxw logical :: do_physb ! !locals ! integer :: inc, jk, jl, iazi ! - real :: zang, zang1, znorm - real :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp + real(kind_phys) :: zang, zang1, znorm + real(kind_phys) :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp if( nwaves == 0) then ! diff --git a/physics/cires_ugwp_module.F90 b/physics/cires_ugwp_module.F90 index 3b3ce3114..7973b3185 100644 --- a/physics/cires_ugwp_module.F90 +++ b/physics/cires_ugwp_module.F90 @@ -2,6 +2,8 @@ module cires_ugwpv0_module + use machine, only: kind_phys + ! ! driver is called after pbl & before chem-parameterizations ! @@ -12,17 +14,17 @@ module cires_ugwpv0_module logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver - real, parameter :: arad=6370.e3 - real, parameter :: pi = atan(1.0) - real, parameter :: pi2 = 2.*pi - real, parameter :: hps = 7000. - real, parameter :: hpskm = hps/1000. + real(kind_phys), parameter :: arad=6370.e3 + real(kind_phys), parameter :: pi = atan(1.0) + real(kind_phys), parameter :: pi2 = 2.*pi + real(kind_phys), parameter :: hps = 7000. + real(kind_phys), parameter :: hpskm = hps/1000. ! - real :: kxw = 6.28e-3/100. ! single horizontal wavenumber of ugwp schemes - real, parameter :: ricrit = 0.25 - real, parameter :: frcrit = 0.50 - real, parameter :: linsat = 1.00 - real, parameter :: linsat2 = linsat*linsat + real(kind_phys) :: kxw = 6.28e-3/100. ! single horizontal wavenumber of ugwp schemes + real(kind_phys), parameter :: ricrit = 0.25 + real(kind_phys), parameter :: frcrit = 0.50 + real(kind_phys), parameter :: linsat = 1.00 + real(kind_phys), parameter :: linsat2 = linsat*linsat ! integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) @@ -30,7 +32,7 @@ module cires_ugwpv0_module integer, dimension(4) :: knob_ugwp_wvspec ! number of waves for- (oro, fronts, conv, imbf-owp] integer, dimension(4) :: knob_ugwp_azdir ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] integer, dimension(4) :: knob_ugwp_stoch ! 1 - deterministic ; 0 - stochastic - real, dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] + real(kind_phys), dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag integer :: knob_ugwp_doheat=1 ! 1 -gwheat @@ -42,7 +44,7 @@ module cires_ugwpv0_module integer :: ugwp_src integer :: ugwp_nws - real :: ugwp_effac + real(kind_phys) :: ugwp_effac ! data knob_ugwp_source / 1,0, 1, 0 / ! oro-conv-fjet-okw-taub_lat: 1-active 0-off @@ -73,27 +75,27 @@ module cires_ugwpv0_module ! allocatable arrays, initilized during "cires_ugwp_init" & ! released during "cires_ugwp_finalize" ! - real, allocatable :: kvg(:), ktg(:), krad(:), kion(:) - real, allocatable :: zkm(:), pmb(:) - real, allocatable :: rfdis(:), rfdist(:) + real(kind_phys), allocatable :: kvg(:), ktg(:), krad(:), kion(:) + real(kind_phys), allocatable :: zkm(:), pmb(:) + real(kind_phys), allocatable :: rfdis(:), rfdist(:) integer :: levs_rf - real :: pa_rf, tau_rf + real(kind_phys) :: pa_rf, tau_rf ! ! limiters ! - real, parameter :: max_kdis = 400. ! 400 m2/s - real, parameter :: max_axyz = 400.e-5 ! 400 m/s/day - real, parameter :: max_eps = max_kdis*4.e-7 ! ~16 K/day + real(kind_phys), parameter :: max_kdis = 400. ! 400 m2/s + real(kind_phys), parameter :: max_axyz = 400.e-5 ! 400 m/s/day + real(kind_phys), parameter :: max_eps = max_kdis*4.e-7 ! ~16 K/day ! !====================================================================== - real, parameter :: F_coriol=1 ! Coriolis effects - real, parameter :: F_nonhyd=1 ! Nonhydrostatic waves - real, parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below - real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw - real, parameter :: iPr_turb =1./3., iPr_mol =1.95 - real, parameter :: rhp1=1./hps, rhp2=0.5*rhp1, rhp4 = rhp2*rhp2 - real, parameter :: khp = 0.287*rhp1 ! R/Cp/Hp - real, parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model + real(kind_phys), parameter :: F_coriol=1 ! Coriolis effects + real(kind_phys), parameter :: F_nonhyd=1 ! Nonhydrostatic waves + real(kind_phys), parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below + real(kind_phys), parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + real(kind_phys), parameter :: iPr_turb =1./3., iPr_mol =1.95 + real(kind_phys), parameter :: rhp1=1./hps, rhp2=0.5*rhp1, rhp4 = rhp2*rhp2 + real(kind_phys), parameter :: khp = 0.287*rhp1 ! R/Cp/Hp + real(kind_phys), parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model contains ! @@ -122,14 +124,14 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & integer, intent (in) :: lonr integer, intent (in) :: levs integer, intent (in) :: latr - real, intent (in) :: ak(levs+1), bk(levs+1), pref - real, intent (in) :: dtp - real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes - real, intent (in) :: pa_rf_in, tau_rf_in + real(kind_phys), intent (in) :: ak(levs+1), bk(levs+1), pref + real(kind_phys), intent (in) :: dtp + real(kind_phys), intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes + real(kind_phys), intent (in) :: pa_rf_in, tau_rf_in integer :: ios logical :: exists - real :: dxsg + real(kind_phys) :: dxsg integer :: k #ifdef INTERNAL_FILE_NML @@ -175,7 +177,7 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & ! do k=1, levs pmb(k) = 1.e0*(ak(k) + pref*bk(k)) ! Pa -unit Pref = 1.e5 - zkm(k) = -hpskm*alog(pmb(k)/pref) + zkm(k) = -hpskm*log(pmb(k)/pref) enddo ! ! Part-1 :init_global_gwdis diff --git a/physics/cires_ugwp_triggers.F90 b/physics/cires_ugwp_triggers.F90 index ba7483eca..421458b71 100644 --- a/physics/cires_ugwp_triggers.F90 +++ b/physics/cires_ugwp_triggers.F90 @@ -2,6 +2,7 @@ !! module cires_ugwp_triggers + use machine, only: kind_phys contains ! @@ -11,8 +12,8 @@ subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) !================= implicit none integer :: im - real :: tau_amp, xlatdeg(im), tau_gw(im) - real :: latdeg, flat_gw, tem + real(kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im) + real(kind_phys) :: latdeg, flat_gw, tem integer :: i ! @@ -44,11 +45,11 @@ subroutine slat_geos5_v0(im, xlatdeg, tau_gw) !================= implicit none integer :: im - real :: xlatdeg(im) - real :: tau_gw(im) - real :: latdeg - real, parameter :: tau_amp = 100.e-3 - real :: trop_gw, flat_gw + real(kind_phys) :: xlatdeg(im) + real(kind_phys) :: tau_gw(im) + real(kind_phys) :: latdeg + real(kind_phys), parameter :: tau_amp = 100.e-3 + real(kind_phys) :: trop_gw, flat_gw integer :: i ! ! if-lat @@ -81,9 +82,9 @@ subroutine init_nazdir_v0(naz, xaz, yaz) use ugwp_common_v0 , only : pi2 implicit none integer :: naz - real, dimension(naz) :: xaz, yaz + real(kind_phys), dimension(naz) :: xaz, yaz integer :: idir - real :: phic, drad + real(kind_phys) :: phic, drad drad = pi2/float(naz) if (naz.ne.4) then do idir =1, naz diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 16e446b27..7e1ad51a0 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -223,7 +223,7 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, if (.not. exists) then write(6,*) 'gcycle:: namelist file: ',trim(fn_nml),' does not exist' errflg = 1 - errmsg = 'ERROR(gcycle): namelist file: ',trim(fn_nml),' does not exist.' + errmsg = 'ERROR(gcycle): namelist file: ' // trim(fn_nml) // ' does not exist.' return else open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios) diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/maximum_hourly_diagnostics.F90 index cd1016053..e709af381 100644 --- a/physics/maximum_hourly_diagnostics.F90 +++ b/physics/maximum_hourly_diagnostics.F90 @@ -223,16 +223,16 @@ end subroutine lightning_threat_indices end subroutine maximum_hourly_diagnostics_run subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) - integer, intent(in) :: im,levs - real (kind=kind_phys), intent(in) :: grav - real (kind=kind_phys), intent(in),dimension(:,:) :: phil,ref3D,tk - integer :: i,k,ll,ipt,kpt - real :: dbz1avg,zmidp1,zmidloc,refl,fact - real, dimension(im,levs) :: z - real, dimension(im) :: zintsfc - real, dimension(:), intent(inout) :: refd,refd263k - REAL :: dbz1(2),dbzk,dbzk1 - logical :: counter + integer, intent(in) :: im,levs + real(kind=kind_phys), intent(in) :: grav + real(kind=kind_phys), intent(in),dimension(:,:) :: phil,ref3D,tk + integer i,k,ll,ipt,kpt + real(kind_phys) dbz1avg,zmidp1,zmidloc,refl,fact + real(kind_phys), dimension(im,levs) :: z + real(kind_phys), dimension(im) :: zintsfc + real(kind_phys), dimension(:), intent(inout) :: refd,refd263k + REAL(kind_phys) dbz1(2),dbzk,dbzk1 + logical counter do i=1,im do k=1,levs z(i,k)=phil(i,k)/grav @@ -268,7 +268,7 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) dbz1avg=dbz1(2)+(dbz1(2)-dbz1(1))*fact !-- Convert to dBZ (10*logZ) as the last step if (dbz1avg>0.01) then - dbz1avg=10.*alog10(dbz1avg) + dbz1avg=10.*log10(dbz1avg) else dbz1avg=-35. endif @@ -297,7 +297,7 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) dbz1avg=maxval(dbz1) !-- Convert to dBZ (10*logZ) as the last step if (dbz1avg>0.01) then - dbz1avg=10.*alog10(dbz1avg) + dbz1avg=10.*log10(dbz1avg) else dbz1avg=-35. endif diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 5cab1abbc..10f443621 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -39,6 +39,7 @@ module gfdl_cloud_microphys_mod ! use fms_mod, only: write_version_number, open_namelist_file, & ! check_nml_error, file_exist, close_file + use machine, only: kind_phys use module_mp_radar implicit none @@ -51,98 +52,98 @@ module gfdl_cloud_microphys_mod ! public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d ! public setup_con, wet_bulb - real :: missing_value = - 1.e10 + real(kind_phys) :: missing_value = - 1.e10 logical :: module_is_initialized = .false. logical :: qsmith_tables_initialized = .false. character (len = 17) :: mod_name = 'gfdl_cloud_microphys' - real, parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real, parameter :: rhos = 0.1e3, rhog = 0.4e3 - real, parameter :: grav = 9.80665 !< gfs: acceleration due to gravity - real, parameter :: rdgas = 287.05 !< gfs: gas constant for dry air - real, parameter :: rvgas = 461.50 !< gfs: gas constant for water vapor - real, parameter :: cp_air = 1004.6 !< gfs: heat capacity of dry air at constant pressure - real, parameter :: hlv = 2.5e6 !< gfs: latent heat of evaporation - real, parameter :: hlf = 3.3358e5 !< gfs: latent heat of fusion - real, parameter :: pi = 3.1415926535897931 !< gfs: ratio of circle circumference to diameter - - ! real, parameter :: rdgas = 287.04 !< gfdl: gas constant for dry air - - ! real, parameter :: cp_air = rdgas * 7. / 2. ! 1004.675, heat capacity of dry air at constant pressure - real, parameter :: cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapore at constnat pressure - ! real, parameter :: cv_air = 717.56 ! satoh value - real, parameter :: cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume - ! real, parameter :: cv_vap = 1410.0 ! emanuel value - real, parameter :: cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume + real(kind_phys), parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 + real(kind_phys), parameter :: rhos = 0.1e3, rhog = 0.4e3 + real(kind_phys), parameter :: grav = 9.80665 !< gfs: acceleration due to gravity + real(kind_phys), parameter :: rdgas = 287.05 !< gfs: gas constant for dry air + real(kind_phys), parameter :: rvgas = 461.50 !< gfs: gas constant for water vapor + real(kind_phys), parameter :: cp_air = 1004.6 !< gfs: heat capacity of dry air at constant pressure + real(kind_phys), parameter :: hlv = 2.5e6 !< gfs: latent heat of evaporation + real(kind_phys), parameter :: hlf = 3.3358e5 !< gfs: latent heat of fusion + real(kind_phys), parameter :: pi = 3.1415926535897931 !< gfs: ratio of circle circumference to diameter + + ! real(kind_phys), parameter :: rdgas = 287.04 !< gfdl: gas constant for dry air + + ! real(kind_phys), parameter :: cp_air = rdgas * 7. / 2. ! 1004.675, heat capacity of dry air at constant pressure + real(kind_phys), parameter :: cp_vap = 4.0 * rvgas !< 1846.0, heat capacity of water vapore at constnat pressure + ! real(kind_phys), parameter :: cv_air = 717.56 ! satoh value + real(kind_phys), parameter :: cv_air = cp_air - rdgas !< 717.55, heat capacity of dry air at constant volume + ! real(kind_phys), parameter :: cv_vap = 1410.0 ! emanuel value + real(kind_phys), parameter :: cv_vap = 3.0 * rvgas !< 1384.5, heat capacity of water vapor at constant volume ! the following two are from emanuel's book "atmospheric convection" - ! real, parameter :: c_ice = 2106.0 ! heat capacity of ice at 0 deg c: c = c_ice + 7.3 * (t - tice) - ! real, parameter :: c_liq = 4190.0 ! heat capacity of water at 0 deg c + ! real(kind_phys), parameter :: c_ice = 2106.0 ! heat capacity of ice at 0 deg c: c = c_ice + 7.3 * (t - tice) + ! real(kind_phys), parameter :: c_liq = 4190.0 ! heat capacity of water at 0 deg c - real, parameter :: c_ice = 1972.0 !< gfdl: heat capacity of ice at - 15 deg c - real, parameter :: c_liq = 4185.5 !< gfdl: heat capacity of water at 15 deg c - ! real, parameter :: c_liq = 4218.0 ! ifs: heat capacity of liquid at 0 deg c + real(kind_phys), parameter :: c_ice = 1972.0 !< gfdl: heat capacity of ice at - 15 deg c + real(kind_phys), parameter :: c_liq = 4185.5 !< gfdl: heat capacity of water at 15 deg c + ! real(kind_phys), parameter :: c_liq = 4218.0 ! ifs: heat capacity of liquid at 0 deg c - real, parameter :: eps = rdgas / rvgas !< 0.6219934995 - real, parameter :: zvir = rvgas / rdgas - 1. !< 0.6077338443 + real(kind_phys), parameter :: eps = rdgas / rvgas !< 0.6219934995 + real(kind_phys), parameter :: zvir = rvgas / rdgas - 1. !< 0.6077338443 - real, parameter :: t_ice = 273.16 !< freezing temperature - real, parameter :: table_ice = 273.16 !< freezing point for qs table + real(kind_phys), parameter :: t_ice = 273.16 !< freezing temperature + real(kind_phys), parameter :: table_ice = 273.16 !< freezing point for qs table - ! real, parameter :: e00 = 610.71 ! gfdl: saturation vapor pressure at 0 deg c - real, parameter :: e00 = 611.21 !< ifs: saturation vapor pressure at 0 deg c + ! real(kind_phys), parameter :: e00 = 610.71 ! gfdl: saturation vapor pressure at 0 deg c + real(kind_phys), parameter :: e00 = 611.21 !< ifs: saturation vapor pressure at 0 deg c - real, parameter :: dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling - real, parameter :: dc_ice = c_liq - c_ice !< 2213.5, isobaric heating / colling + real(kind_phys), parameter :: dc_vap = cp_vap - c_liq !< - 2339.5, isobaric heating / cooling + real(kind_phys), parameter :: dc_ice = c_liq - c_ice !< 2213.5, isobaric heating / colling - real, parameter :: hlv0 = hlv !< gfs: evaporation latent heat coefficient at 0 deg c - ! real, parameter :: hlv0 = 2.501e6 ! emanuel appendix - 2 - real, parameter :: hlf0 = hlf !< gfs: fussion latent heat coefficient at 0 deg c - ! real, parameter :: hlf0 = 3.337e5 ! emanuel + real(kind_phys), parameter :: hlv0 = hlv !< gfs: evaporation latent heat coefficient at 0 deg c + ! real(kind_phys), parameter :: hlv0 = 2.501e6 ! emanuel appendix - 2 + real(kind_phys), parameter :: hlf0 = hlf !< gfs: fussion latent heat coefficient at 0 deg c + ! real(kind_phys), parameter :: hlf0 = 3.337e5 ! emanuel - real, parameter :: lv0 = hlv0 - dc_vap * t_ice !< 3.13905782e6, evaporation latent heat coefficient at 0 deg k - real, parameter :: li00 = hlf0 - dc_ice * t_ice !< - 2.7105966e5, fusion latent heat coefficient at 0 deg k + real(kind_phys), parameter :: lv0 = hlv0 - dc_vap * t_ice !< 3.13905782e6, evaporation latent heat coefficient at 0 deg k + real(kind_phys), parameter :: li00 = hlf0 - dc_ice * t_ice !< - 2.7105966e5, fusion latent heat coefficient at 0 deg k - real, parameter :: d2ice = dc_vap + dc_ice !< - 126, isobaric heating/cooling - real, parameter :: li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k + real(kind_phys), parameter :: d2ice = dc_vap + dc_ice !< - 126, isobaric heating/cooling + real(kind_phys), parameter :: li2 = lv0 + li00 !< 2.86799816e6, sublimation latent heat coefficient at 0 deg k - real, parameter :: qrmin = 1.e-8 !< min value for rain - real, parameter :: qvmin = 1.e-20 !< min value for water vapor (treated as zero) - real, parameter :: qcmin = 1.e-12 !< min value for cloud condensates + real(kind_phys), parameter :: qrmin = 1.e-8 !< min value for rain + real(kind_phys), parameter :: qvmin = 1.e-20 !< min value for water vapor (treated as zero) + real(kind_phys), parameter :: qcmin = 1.e-12 !< min value for cloud condensates - real, parameter :: vr_min = 1.e-3 !< min fall speed for rain - real, parameter :: vf_min = 1.e-5 !< min fall speed for cloud ice, snow, graupel + real(kind_phys), parameter :: vr_min = 1.e-3 !< min fall speed for rain + real(kind_phys), parameter :: vf_min = 1.e-5 !< min fall speed for cloud ice, snow, graupel - real, parameter :: dz_min = 1.e-2 !< use for correcting flipped height + real(kind_phys), parameter :: dz_min = 1.e-2 !< use for correcting flipped height - real, parameter :: sfcrho = 1.2 !< surface air density - real, parameter :: rhor = 1.e3 !< density of rain water, lin83 + real(kind_phys), parameter :: sfcrho = 1.2 !< surface air density + real(kind_phys), parameter :: rhor = 1.e3 !< density of rain water, lin83 ! intercept parameters - real, parameter :: rnzr = 8.0e6 ! lin83 - real, parameter :: rnzs = 3.0e6 ! lin83 - real, parameter :: rnzg = 4.0e6 ! rh84 - real, parameter :: rnzh = 4.0e4 ! lin83 --- lmh 29 sep 17 + real(kind_phys), parameter :: rnzr = 8.0e6 ! lin83 + real(kind_phys), parameter :: rnzs = 3.0e6 ! lin83 + real(kind_phys), parameter :: rnzg = 4.0e6 ! rh84 + real(kind_phys), parameter :: rnzh = 4.0e4 ! lin83 --- lmh 29 sep 17 ! density parameters - real, parameter :: rhoh = 0.917e3 ! lin83 --- lmh 29 sep 17 + real(kind_phys), parameter :: rhoh = 0.917e3 ! lin83 --- lmh 29 sep 17 public rhor, rhos, rhog, rhoh, rnzr, rnzs, rnzg, rnzh - real :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw !< constants for accretions - real :: acco (3, 4) !< constants for accretions - real :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (5), cgmlt (5) + real(kind_phys) :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw !< constants for accretions + real(kind_phys) :: acco (3, 4) !< constants for accretions + real(kind_phys) :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (5), cgmlt (5) - real :: es0, ces0 - real :: pie, rgrav, fac_rc - real :: c_air, c_vap + real(kind_phys) :: es0, ces0 + real(kind_phys) :: pie, rgrav, fac_rc + real(kind_phys) :: c_air, c_vap - real :: lati, latv, lats, lat2, lcp, icp, tcp !< used in Bigg mechanism and wet bulk + real(kind_phys) :: lati, latv, lats, lat2, lcp, icp, tcp !< used in Bigg mechanism and wet bulk - real :: d0_vap !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap - real :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap + real(kind_phys) :: d0_vap !< the same as dc_vap, except that cp_vap can be cp_vap or cv_vap + real(kind_phys) :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap ! cloud microphysics switchers @@ -162,19 +163,19 @@ module gfdl_cloud_microphys_mod logical :: do_setup = .true. !< setup constants and parameters logical :: p_nonhydro = .false. !< perform hydrosatic adjustment on air density - real, allocatable :: table (:), table2 (:), table3 (:), tablew (:) - real, allocatable :: des (:), des2 (:), des3 (:), desw (:) + real(kind_phys), allocatable :: table (:), table2 (:), table3 (:), tablew (:) + real(kind_phys), allocatable :: des (:), des2 (:), des3 (:), desw (:) logical :: tables_are_initialized = .false. ! logical :: master ! integer :: id_rh, id_vtr, id_vts, id_vtg, id_vti, id_rain, id_snow, id_graupel, & ! id_ice, id_prec, id_cond, id_var, id_droplets - real, parameter :: dt_fr = 8. !< homogeneous freezing of all cloud water at t_wfr - dt_fr + real(kind_phys), parameter :: dt_fr = 8. !< homogeneous freezing of all cloud water at t_wfr - dt_fr ! minimum temperature water can exist (moore & molinero nov. 2011, nature) ! dt_fr can be considered as the error bar - real :: p_min = 100. !< minimum pressure (pascal) for mp to operate + real(kind_phys) :: p_min = 100. !< minimum pressure (pascal) for mp to operate ! slj, the following parameters are for cloud - resolving resolution: 1 - 5 km @@ -187,43 +188,43 @@ module gfdl_cloud_microphys_mod ! namelist parameters ! ----------------------------------------------------------------------- - real :: cld_min = 0.05 !< minimum cloud fraction - real :: tice = 273.16 !< set tice = 165. to trun off ice - phase phys (kessler emulator) + real(kind_phys) :: cld_min = 0.05 !< minimum cloud fraction + real(kind_phys) :: tice = 273.16 !< set tice = 165. to trun off ice - phase phys (kessler emulator) - real :: t_min = 178. !< min temp to freeze - dry all water vapor - real :: t_sub = 184. !< min temp for sublimation of cloud ice - real :: mp_time = 150. !< maximum micro - physics time step (sec) + real(kind_phys) :: t_min = 178. !< min temp to freeze - dry all water vapor + real(kind_phys) :: t_sub = 184. !< min temp for sublimation of cloud ice + real(kind_phys) :: mp_time = 150. !< maximum micro - physics time step (sec) ! relative humidity increment - real :: rh_inc = 0.25 !< rh increment for complete evaporation of cloud water and cloud ice - real :: rh_inr = 0.25 !< rh increment for minimum evaporation of rain - real :: rh_ins = 0.25 !< rh increment for sublimation of snow + real(kind_phys) :: rh_inc = 0.25 !< rh increment for complete evaporation of cloud water and cloud ice + real(kind_phys) :: rh_inr = 0.25 !< rh increment for minimum evaporation of rain + real(kind_phys) :: rh_ins = 0.25 !< rh increment for sublimation of snow ! conversion time scale - real :: tau_r2g = 900. !< rain freezing during fast_sat - real :: tau_smlt = 900. !< snow melting - real :: tau_g2r = 600. !< graupel melting to rain - real :: tau_imlt = 600. !< cloud ice melting - real :: tau_i2s = 1000. !< cloud ice to snow auto-conversion - real :: tau_l2r = 900. !< cloud water to rain auto-conversion - real :: tau_v2l = 150. !< water vapor to cloud water (condensation) - real :: tau_l2v = 300. !< cloud water to water vapor (evaporation) - real :: tau_g2v = 900. !< graupel sublimation - real :: tau_v2g = 21600. !< graupel deposition -- make it a slow process + real(kind_phys) :: tau_r2g = 900. !< rain freezing during fast_sat + real(kind_phys) :: tau_smlt = 900. !< snow melting + real(kind_phys) :: tau_g2r = 600. !< graupel melting to rain + real(kind_phys) :: tau_imlt = 600. !< cloud ice melting + real(kind_phys) :: tau_i2s = 1000. !< cloud ice to snow auto-conversion + real(kind_phys) :: tau_l2r = 900. !< cloud water to rain auto-conversion + real(kind_phys) :: tau_v2l = 150. !< water vapor to cloud water (condensation) + real(kind_phys) :: tau_l2v = 300. !< cloud water to water vapor (evaporation) + real(kind_phys) :: tau_g2v = 900. !< graupel sublimation + real(kind_phys) :: tau_v2g = 21600. !< graupel deposition -- make it a slow process ! horizontal subgrid variability - real :: dw_land = 0.20 !< base value for subgrid deviation / variability over land - real :: dw_ocean = 0.10 !< base value for ocean + real(kind_phys) :: dw_land = 0.20 !< base value for subgrid deviation / variability over land + real(kind_phys) :: dw_ocean = 0.10 !< base value for ocean ! prescribed ccn - real :: ccn_o = 90. !< ccn over ocean (cm^ - 3) - real :: ccn_l = 270. !< ccn over land (cm^ - 3) + real(kind_phys) :: ccn_o = 90. !< ccn over ocean (cm^ - 3) + real(kind_phys) :: ccn_l = 270. !< ccn over land (cm^ - 3) - real :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) + real(kind_phys) :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) ! ----------------------------------------------------------------------- ! wrf / wsm6 scheme: qi_gen = 4.92e-11 * (1.e3 * exp (0.1 * tmp)) ** 1.33 @@ -233,39 +234,39 @@ module gfdl_cloud_microphys_mod ! wrf / wsm6 ice initiation scheme; qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den ! ----------------------------------------------------------------------- - real :: sat_adj0 = 0.90 !< adjustment factor (0: no, 1: full) during fast_sat_adj + real(kind_phys) :: sat_adj0 = 0.90 !< adjustment factor (0: no, 1: full) during fast_sat_adj - real :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness + real(kind_phys) :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness - real :: qi_lim = 1. !< cloud ice limiter to prevent large ice build up + real(kind_phys) :: qi_lim = 1. !< cloud ice limiter to prevent large ice build up - real :: ql_mlt = 2.0e-3 !< max value of cloud water allowed from melted cloud ice - real :: qs_mlt = 1.0e-6 !< max cloud water due to snow melt + real(kind_phys) :: ql_mlt = 2.0e-3 !< max value of cloud water allowed from melted cloud ice + real(kind_phys) :: qs_mlt = 1.0e-6 !< max cloud water due to snow melt - real :: ql_gen = 1.0e-3 !< max cloud water generation during remapping step if fast_sat_adj = .t. - real :: qi_gen = 1.82e-6 !< max cloud ice generation during remapping step + real(kind_phys) :: ql_gen = 1.0e-3 !< max cloud water generation during remapping step if fast_sat_adj = .t. + real(kind_phys) :: qi_gen = 1.82e-6 !< max cloud ice generation during remapping step ! cloud condensate upper bounds: "safety valves" for ql & qi - real :: ql0_max = 2.0e-3 !< max cloud water value (auto converted to rain) - real :: qi0_max = 1.0e-4 !< max cloud ice value (by other sources) + real(kind_phys) :: ql0_max = 2.0e-3 !< max cloud water value (auto converted to rain) + real(kind_phys) :: qi0_max = 1.0e-4 !< max cloud ice value (by other sources) - real :: qi0_crt = 1.0e-4 !< cloud ice to snow autoconversion threshold (was 1.e-4); + real(kind_phys) :: qi0_crt = 1.0e-4 !< cloud ice to snow autoconversion threshold (was 1.e-4); !! qi0_crt is highly dependent on horizontal resolution - real :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold + real(kind_phys) :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold ! lfo used * mixing ratio * = 1.e-4 (hail in lfo) - real :: qs0_crt = 1.0e-3 !< snow to graupel density threshold (0.6e-3 in purdue lin scheme) + real(kind_phys) :: qs0_crt = 1.0e-3 !< snow to graupel density threshold (0.6e-3 in purdue lin scheme) - real :: c_paut = 0.55 !< autoconversion cloud water to rain (use 0.5 to reduce autoconversion) - real :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) - real :: c_piacr = 5.0 !< accretion: rain to ice: - real :: c_cracw = 0.9 !< rain accretion efficiency - real :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) + real(kind_phys) :: c_paut = 0.55 !< autoconversion cloud water to rain (use 0.5 to reduce autoconversion) + real(kind_phys) :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) + real(kind_phys) :: c_piacr = 5.0 !< accretion: rain to ice: + real(kind_phys) :: c_cracw = 0.9 !< rain accretion efficiency + real(kind_phys) :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) ! decreasing clin to reduce csacw (so as to reduce cloud water --- > snow) - real :: alin = 842.0 !< "a" in lin1983 - real :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) + real(kind_phys) :: alin = 842.0 !< "a" in lin1983 + real(kind_phys) :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) ! fall velocity tuning constants: @@ -276,17 +277,17 @@ module gfdl_cloud_microphys_mod ! good values: - real :: vi_fac = 1. !< if const_vi: 1 / 3 - real :: vs_fac = 1. !< if const_vs: 1. - real :: vg_fac = 1. !< if const_vg: 2. - real :: vr_fac = 1. !< if const_vr: 4. + real(kind_phys) :: vi_fac = 1. !< if const_vi: 1 / 3 + real(kind_phys) :: vs_fac = 1. !< if const_vs: 1. + real(kind_phys) :: vg_fac = 1. !< if const_vg: 2. + real(kind_phys) :: vr_fac = 1. !< if const_vr: 4. ! upper bounds of fall speed (with variable speed option) - real :: vi_max = 0.5 !< max fall speed for ice - real :: vs_max = 5.0 !< max fall speed for snow - real :: vg_max = 8.0 !< max fall speed for graupel - real :: vr_max = 12. !< max fall speed for rain + real(kind_phys) :: vi_max = 0.5 !< max fall speed for ice + real(kind_phys) :: vs_max = 5.0 !< max fall speed for snow + real(kind_phys) :: vg_max = 8.0 !< max fall speed for graupel + real(kind_phys) :: vr_max = 12. !< max fall speed for rain ! cloud microphysics switchers @@ -299,9 +300,9 @@ module gfdl_cloud_microphys_mod logical :: mp_print = .false. !< cloud microphysics debugging printout logical :: do_hail = .false. !< use hail parameters instead of graupel - ! real :: global_area = - 1. + ! real(kind_phys) :: global_area = - 1. - real :: log_10, tice0, t_wfr + real(kind_phys) :: log_10, tice0, t_wfr integer :: reiflag = 1 ! 1: Heymsfield and Mcfarquhar, 1996 @@ -309,11 +310,11 @@ module gfdl_cloud_microphys_mod logical :: tintqs = .false. !< use temperature in the saturation mixing in PDF - real :: rewmin = 5.0, rewmax = 10.0 - real :: reimin = 10.0, reimax = 150.0 - real :: rermin = 10.0, rermax = 10000.0 - real :: resmin = 150.0, resmax = 10000.0 - real :: regmin = 300.0, regmax = 10000.0 + real(kind_phys) :: rewmin = 5.0, rewmax = 10.0 + real(kind_phys) :: reimin = 10.0, reimax = 150.0 + real(kind_phys) :: rermin = 10.0, rermax = 10000.0 + real(kind_phys) :: resmin = 150.0, resmax = 10000.0 + real(kind_phys) :: regmin = 300.0, regmax = 10000.0 ! ----------------------------------------------------------------------- ! namelist @@ -370,50 +371,50 @@ subroutine gfdl_cloud_microphys_mod_driver ( integer, intent (in) :: kks, kke ! vertical dimension integer, intent (in) :: ktop, kbot ! vertical compute domain - real, intent (in) :: dt_in ! physics time step + real(kind_phys), intent (in) :: dt_in ! physics time step - real, intent (in), dimension (iis:iie, jjs:jje) :: area ! cell area - real, intent (in), dimension (iis:iie, jjs:jje) :: land ! land fraction + real(kind_phys), intent (in), dimension (iis:iie, jjs:jje) :: area ! cell area + real(kind_phys), intent (in), dimension (iis:iie, jjs:jje) :: land ! land fraction - real, intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: delp, dz, uin, vin - real, intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: pt, qv, ql, qr, qg, qa, qn + real(kind_phys), intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: delp, dz, uin, vin + real(kind_phys), intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: pt, qv, ql, qr, qg, qa, qn - real, intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qi, qs - real, intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: pt_dt, qa_dt, udt, vdt, w - real, intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qv_dt, ql_dt, qr_dt - real, intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qi_dt, qs_dt, qg_dt + real(kind_phys), intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qi, qs + real(kind_phys), intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: pt_dt, qa_dt, udt, vdt, w + real(kind_phys), intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qv_dt, ql_dt, qr_dt + real(kind_phys), intent (inout), dimension (iis:iie, jjs:jje, kks:kke) :: qi_dt, qs_dt, qg_dt - real, intent (out), dimension (iis:iie, jjs:jje) :: rain, snow, ice, graupel + real(kind_phys), intent (out), dimension (iis:iie, jjs:jje) :: rain, snow, ice, graupel logical, intent (in) :: hydrostatic, phys_hydrostatic !integer, intent (in) :: seconds - real, intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: p + real(kind_phys), intent (in), dimension (iis:iie, jjs:jje, kks:kke) :: p logical, intent (in) :: lradar - real, intent (out), dimension (iis:iie, jjs:jje, kks:kke) :: refl_10cm + real(kind_phys), intent (out), dimension (iis:iie, jjs:jje, kks:kke) :: refl_10cm logical, intent (in) :: reset - real, intent (out), dimension (iis:iie, jjs:jje, kks:kke) :: pfils, pflls + real(kind_phys), intent (out), dimension (iis:iie, jjs:jje, kks:kke) :: pfils, pflls ! Local variables logical :: melti = .false. - real :: mpdt, rdt, dts, convt, tot_prec + real(kind_phys) :: mpdt, rdt, dts, convt, tot_prec integer :: i, j, k integer :: is, ie, js, je ! physics window integer :: ks, ke ! vertical dimension integer :: days, ntimes, kflip - real, dimension (iie-iis+1, jje-jjs+1) :: prec_mp, prec1, cond, w_var, rh0 + real(kind_phys), dimension (iie-iis+1, jje-jjs+1) :: prec_mp, prec1, cond, w_var, rh0 - real, dimension (iie-iis+1, jje-jjs+1,kke-kks+1) :: vt_r, vt_s, vt_g, vt_i, qn2 + real(kind_phys), dimension (iie-iis+1, jje-jjs+1,kke-kks+1) :: vt_r, vt_s, vt_g, vt_i, qn2 - real, dimension (size(pt,1), size(pt,3)) :: m2_rain, m2_sol + real(kind_phys), dimension (size(pt,1), size(pt,3)) :: m2_rain, m2_sol - real :: allmax + real(kind_phys) :: allmax !+---+-----------------------------------------------------------------+ !For 3D reflectivity calculations - real, dimension(ktop:kbot):: qv1d, t1d, p1d, qr1d, qs1d, qg1d, dBZ + real(kind_phys), dimension(ktop:kbot):: qv1d, t1d, p1d, qr1d, qs1d, qg1d, dBZ !+---+-----------------------------------------------------------------+ is = 1 @@ -687,39 +688,39 @@ subroutine mpdrv (hydrostatic, uin, vin, w, delp, pt, qv, ql, qr, qi, qs, & integer, intent (in) :: j, is, ie, js, je, ks, ke integer, intent (in) :: ntimes, ktop, kbot - real, intent (in) :: dt_in + real(kind_phys), intent (in) :: dt_in - real, intent (in), dimension (is:) :: area1, land + real(kind_phys), intent (in), dimension (is:) :: area1, land - real, intent (in), dimension (is:, js:, ks:) :: uin, vin, delp, pt, dz - real, intent (in), dimension (is:, js:, ks:) :: qv, ql, qr, qg, qa, qn + real(kind_phys), intent (in), dimension (is:, js:, ks:) :: uin, vin, delp, pt, dz + real(kind_phys), intent (in), dimension (is:, js:, ks:) :: qv, ql, qr, qg, qa, qn - real, intent (inout), dimension (is:, js:, ks:) :: qi, qs - real, intent (inout), dimension (is:, js:, ks:) :: u_dt, v_dt, w, pt_dt, qa_dt - real, intent (inout), dimension (is:, js:, ks:) :: qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt + real(kind_phys), intent (inout), dimension (is:, js:, ks:) :: qi, qs + real(kind_phys), intent (inout), dimension (is:, js:, ks:) :: u_dt, v_dt, w, pt_dt, qa_dt + real(kind_phys), intent (inout), dimension (is:, js:, ks:) :: qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt - real, intent (inout), dimension (is:) :: rain, snow, ice, graupel, cond + real(kind_phys), intent (inout), dimension (is:) :: rain, snow, ice, graupel, cond - real, intent (out), dimension (is:, js:) :: w_var + real(kind_phys), intent (out), dimension (is:, js:) :: w_var - real, intent (out), dimension (is:, js:, ks:) :: vt_r, vt_s, vt_g, vt_i, qn2 + real(kind_phys), intent (out), dimension (is:, js:, ks:) :: vt_r, vt_s, vt_g, vt_i, qn2 - real, intent (out), dimension (is:, ks:) :: m2_rain, m2_sol + real(kind_phys), intent (out), dimension (is:, ks:) :: m2_rain, m2_sol - real, dimension (ktop:kbot) :: qvz, qlz, qrz, qiz, qsz, qgz, qaz - real, dimension (ktop:kbot) :: vtiz, vtsz, vtgz, vtrz - real, dimension (ktop:kbot) :: dp0, dp1, dz0, dz1 - real, dimension (ktop:kbot) :: qv0, ql0, qr0, qi0, qs0, qg0, qa0 - real, dimension (ktop:kbot) :: t0, den, den0, tz, p1, denfac - real, dimension (ktop:kbot) :: ccn, c_praut, m1_rain, m1_sol, m1 - real, dimension (ktop:kbot) :: u0, v0, u1, v1, w1 + real(kind_phys), dimension (ktop:kbot) :: qvz, qlz, qrz, qiz, qsz, qgz, qaz + real(kind_phys), dimension (ktop:kbot) :: vtiz, vtsz, vtgz, vtrz + real(kind_phys), dimension (ktop:kbot) :: dp0, dp1, dz0, dz1 + real(kind_phys), dimension (ktop:kbot) :: qv0, ql0, qr0, qi0, qs0, qg0, qa0 + real(kind_phys), dimension (ktop:kbot) :: t0, den, den0, tz, p1, denfac + real(kind_phys), dimension (ktop:kbot) :: ccn, c_praut, m1_rain, m1_sol, m1 + real(kind_phys), dimension (ktop:kbot) :: u0, v0, u1, v1, w1 - real :: cpaut, rh_adj, rh_rain - real :: r1, s1, i1, g1, rdt, ccn0 - real :: dt_rain, dts - real :: s_leng, t_land, t_ocean, h_var - real :: cvm, tmp, omq - real :: dqi, qio, qin + real(kind_phys) :: cpaut, rh_adj, rh_rain + real(kind_phys) :: r1, s1, i1, g1, rdt, ccn0 + real(kind_phys) :: dt_rain, dts + real(kind_phys) :: s_leng, t_land, t_ocean, h_var + real(kind_phys) :: cvm, tmp, omq + real(kind_phys) :: dqi, qio, qin integer :: i, k, n @@ -1105,15 +1106,15 @@ subroutine sedi_heat (ktop, kbot, dm, m1, dz, tz, qv, ql, qr, qi, qs, qg, cw) integer, intent (in) :: ktop, kbot - real, intent (in), dimension (ktop:kbot) :: dm, m1, dz, qv, ql, qr, qi, qs, qg + real(kind_phys), intent (in), dimension (ktop:kbot) :: dm, m1, dz, qv, ql, qr, qi, qs, qg - real, intent (inout), dimension (ktop:kbot) :: tz + real(kind_phys), intent (inout), dimension (ktop:kbot) :: tz - real, intent (in) :: cw ! heat capacity + real(kind_phys), intent (in) :: cw ! heat capacity - real, dimension (ktop:kbot) :: dgz, cvn + real(kind_phys), dimension (ktop:kbot) :: dgz, cvn - real :: tmp + real(kind_phys) :: tmp integer :: k @@ -1159,35 +1160,35 @@ subroutine warm_rain (dt, ktop, kbot, dp, dz, tz, qv, ql, qr, qi, qs, qg, & integer, intent (in) :: ktop, kbot - real, intent (in) :: dt ! time step (s) - real, intent (in) :: rh_rain, h_var + real(kind_phys), intent (in) :: dt ! time step (s) + real(kind_phys), intent (in) :: rh_rain, h_var - real, intent (in), dimension (ktop:kbot) :: dp, dz, den - real, intent (in), dimension (ktop:kbot) :: denfac, ccn, c_praut + real(kind_phys), intent (in), dimension (ktop:kbot) :: dp, dz, den + real(kind_phys), intent (in), dimension (ktop:kbot) :: denfac, ccn, c_praut - real, intent (inout), dimension (ktop:kbot) :: tz, vtr - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qi, qs, qg - real, intent (inout), dimension (ktop:kbot) :: m1_rain, w1 + real(kind_phys), intent (inout), dimension (ktop:kbot) :: tz, vtr + real(kind_phys), intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ktop:kbot) :: m1_rain, w1 - real, intent (out) :: r1 + real(kind_phys), intent (out) :: r1 - real, parameter :: so3 = 7. / 3. + real(kind_phys), parameter :: so3 = 7. / 3. - real, dimension (ktop:kbot) :: dl, dm - real, dimension (ktop:kbot + 1) :: ze, zt + real(kind_phys), dimension (ktop:kbot) :: dl, dm + real(kind_phys), dimension (ktop:kbot + 1) :: ze, zt - real :: sink, dq, qc0, qc - real :: qden - real :: zs = 0. - real :: dt5 + real(kind_phys) :: sink, dq, qc0, qc + real(kind_phys) :: qden + real(kind_phys) :: zs = 0. + real(kind_phys) :: dt5 integer :: k ! fall velocity constants: - real, parameter :: vconr = 2503.23638966667 - real, parameter :: normr = 25132741228.7183 - real, parameter :: thr = 1.e-8 + real(kind_phys), parameter :: vconr = 2503.23638966667 + real(kind_phys), parameter :: normr = 25132741228.7183 + real(kind_phys), parameter :: thr = 1.e-8 logical :: no_fall @@ -1378,17 +1379,17 @@ subroutine revap_racc (ktop, kbot, dt, tz, qv, ql, qr, qi, qs, qg, den, denfac, integer, intent (in) :: ktop, kbot - real, intent (in) :: dt ! time step (s) - real, intent (in) :: rh_rain, h_var + real(kind_phys), intent (in) :: dt ! time step (s) + real(kind_phys), intent (in) :: rh_rain, h_var - real, intent (in), dimension (ktop:kbot) :: den, denfac + real(kind_phys), intent (in), dimension (ktop:kbot) :: den, denfac - real, intent (inout), dimension (ktop:kbot) :: tz, qv, qr, ql, qi, qs, qg + real(kind_phys), intent (inout), dimension (ktop:kbot) :: tz, qv, qr, ql, qi, qs, qg - real, dimension (ktop:kbot) :: lhl, cvm, q_liq, q_sol, lcpk + real(kind_phys), dimension (ktop:kbot) :: lhl, cvm, q_liq, q_sol, lcpk - real :: dqv, qsat, dqsdt, evap, t2, qden, q_plus, q_minus, sink - real :: qpz, dq, dqh, tin + real(kind_phys) :: dqv, qsat, dqsdt, evap, t2, qden, q_plus, q_minus, sink + real(kind_phys) :: qpz, dq, dqh, tin integer :: k @@ -1481,13 +1482,13 @@ subroutine linear_prof (km, q, dm, z_var, h_var) integer, intent (in) :: km - real, intent (in) :: q (km), h_var + real(kind_phys), intent (in) :: q (km), h_var - real, intent (out) :: dm (km) + real(kind_phys), intent (out) :: dm (km) logical, intent (in) :: z_var - real :: dq (km) + real(kind_phys) :: dq (km) integer :: k @@ -1547,23 +1548,23 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & integer, intent (in) :: ktop, kbot - real, intent (in), dimension (ktop:kbot) :: p1, dp1, den, denfac, vts, vtg, vtr + real(kind_phys), intent (in), dimension (ktop:kbot) :: p1, dp1, den, denfac, vts, vtg, vtr - real, intent (inout), dimension (ktop:kbot) :: tzk, qvk, qlk, qrk, qik, qsk, qgk, qak + real(kind_phys), intent (inout), dimension (ktop:kbot) :: tzk, qvk, qlk, qrk, qik, qsk, qgk, qak - real, intent (in) :: rh_adj, rh_rain, dts, h_var + real(kind_phys), intent (in) :: rh_adj, rh_rain, dts, h_var - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, di, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol + real(kind_phys), dimension (ktop:kbot) :: lcpk, icpk, tcpk, di, lhl, lhi + real(kind_phys), dimension (ktop:kbot) :: cvm, q_liq, q_sol - real :: rdts, fac_g2v, fac_v2g, fac_i2s, fac_imlt - real :: tz, qv, ql, qr, qi, qs, qg, melt - real :: pracs, psacw, pgacw, psacr, pgacr, pgaci, praci, psaci - real :: pgmlt, psmlt, pgfr, pgaut, psaut, pgsub - real :: tc, tsq, dqs0, qden, qim, qsm - real :: dt5, factor, sink, qi_crt - real :: tmp, qsw, qsi, dqsdt, dq - real :: dtmp, qc, q_plus, q_minus + real(kind_phys) :: rdts, fac_g2v, fac_v2g, fac_i2s, fac_imlt + real(kind_phys) :: tz, qv, ql, qr, qi, qs, qg, melt + real(kind_phys) :: pracs, psacw, pgacw, psacr, pgacr, pgaci, praci, psaci + real(kind_phys) :: pgmlt, psmlt, pgfr, pgaut, psaut, pgsub + real(kind_phys) :: tc, tsq, dqs0, qden, qim, qsm + real(kind_phys) :: dt5, factor, sink, qi_crt + real(kind_phys) :: tmp, qsw, qsi, dqsdt, dq + real(kind_phys) :: dtmp, qc, q_plus, q_minus integer :: k @@ -2034,29 +2035,29 @@ subroutine subgrid_z_proc (ktop, kbot, p1, den, denfac, dts, rh_adj, tz, qv, & integer, intent (in) :: ktop, kbot - real, intent (in), dimension (ktop:kbot) :: p1, den, denfac + real(kind_phys), intent (in), dimension (ktop:kbot) :: p1, den, denfac - real, intent (in) :: dts, rh_adj, h_var, rh_rain + real(kind_phys), intent (in) :: dts, rh_adj, h_var, rh_rain - real, intent (inout), dimension (ktop:kbot) :: tz, qv, ql, qr, qi, qs, qg, qa + real(kind_phys), intent (inout), dimension (ktop:kbot) :: tz, qv, ql, qr, qi, qs, qg, qa - real, dimension (ktop:kbot) :: lcpk, icpk, tcpk, tcp3, lhl, lhi - real, dimension (ktop:kbot) :: cvm, q_liq, q_sol, q_cond + real(kind_phys), dimension (ktop:kbot) :: lcpk, icpk, tcpk, tcp3, lhl, lhi + real(kind_phys), dimension (ktop:kbot) :: cvm, q_liq, q_sol, q_cond - real :: fac_v2l, fac_l2v + real(kind_phys) :: fac_v2l, fac_l2v - real :: pidep, qi_crt + real(kind_phys) :: pidep, qi_crt ! ----------------------------------------------------------------------- ! qstar over water may be accurate only down to - 80 deg c with ~10% uncertainty ! must not be too large to allow psc ! ----------------------------------------------------------------------- - real :: rh, rqi, tin, qsw, qsi, qpz, qstar - real :: dqsdt, dwsdt, dq, dq0, factor, tmp - real :: q_plus, q_minus, dt_evap, dt_pisub - real :: evap, sink, tc, pisub, q_adj, dtmp - real :: pssub, pgsub, tsq, qden, fac_g2v, fac_v2g + real(kind_phys) :: rh, rqi, tin, qsw, qsi, qpz, qstar + real(kind_phys) :: dqsdt, dwsdt, dq, dq0, factor, tmp + real(kind_phys) :: q_plus, q_minus, dt_evap, dt_pisub + real(kind_phys) :: evap, sink, tc, pisub, q_adj, dtmp + real(kind_phys) :: pssub, pgsub, tsq, qden, fac_g2v, fac_v2g integer :: k @@ -2455,16 +2456,16 @@ subroutine revap_rac1 (hydrostatic, is, ie, dt, tz, qv, ql, qr, qi, qs, qg, den, integer, intent (in) :: is, ie - real, intent (in) :: dt ! time step (s) + real(kind_phys), intent (in) :: dt ! time step (s) - real, intent (in), dimension (is:ie) :: den, hvar, qi, qs, qg + real(kind_phys), intent (in), dimension (is:ie) :: den, hvar, qi, qs, qg - real, intent (inout), dimension (is:ie) :: tz, qv, qr, ql + real(kind_phys), intent (inout), dimension (is:ie) :: tz, qv, qr, ql - real, dimension (is:ie) :: lcp2, denfac, q_liq, q_sol, cvm, lhl + real(kind_phys), dimension (is:ie) :: lcp2, denfac, q_liq, q_sol, cvm, lhl - real :: dqv, qsat, dqsdt, evap, qden, q_plus, q_minus, sink - real :: tin, t2, qpz, dq, dqh + real(kind_phys) :: dqv, qsat, dqsdt, evap, qden, q_plus, q_minus, sink + real(kind_phys) :: tin, t2, qpz, dq, dqh integer :: i @@ -2547,25 +2548,25 @@ subroutine terminal_fall (dtm, ktop, kbot, tz, qv, ql, qr, qg, qs, qi, dz, dp, & integer, intent (in) :: ktop, kbot - real, intent (in) :: dtm ! time step (s) + real(kind_phys), intent (in) :: dtm ! time step (s) - real, intent (in), dimension (ktop:kbot) :: vtg, vts, vti, den, dp, dz + real(kind_phys), intent (in), dimension (ktop:kbot) :: vtg, vts, vti, den, dp, dz - real, intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qg, qs, qi, tz, m1_sol, w1 + real(kind_phys), intent (inout), dimension (ktop:kbot) :: qv, ql, qr, qg, qs, qi, tz, m1_sol, w1 - real, intent (out) :: r1, g1, s1, i1 + real(kind_phys), intent (out) :: r1, g1, s1, i1 - real, dimension (ktop:kbot + 1) :: ze, zt + real(kind_phys), dimension (ktop:kbot + 1) :: ze, zt - real :: qsat, dqsdt, dt5, evap, dtime - real :: factor, frac - real :: tmp, precip, tc, sink + real(kind_phys) :: qsat, dqsdt, dt5, evap, dtime + real(kind_phys) :: factor, frac + real(kind_phys) :: tmp, precip, tc, sink - real, dimension (ktop:kbot) :: lcpk, icpk, cvm, q_liq, q_sol, lhl, lhi - real, dimension (ktop:kbot) :: m1, dm + real(kind_phys), dimension (ktop:kbot) :: lcpk, icpk, cvm, q_liq, q_sol, lhl, lhi + real(kind_phys), dimension (ktop:kbot) :: m1, dm - real :: zs = 0. - real :: fac_imlt + real(kind_phys) :: zs = 0. + real(kind_phys) :: fac_imlt integer :: k, k0, m @@ -2858,7 +2859,7 @@ subroutine check_column (ktop, kbot, q, no_fall) integer, intent (in) :: ktop, kbot - real, intent (in) :: q (ktop:kbot) + real(kind_phys), intent (in) :: q (ktop:kbot) logical, intent (out) :: no_fall @@ -2886,19 +2887,19 @@ subroutine implicit_fall (dt, ktop, kbot, ze, vt, dp, q, precip, m1) integer, intent (in) :: ktop, kbot - real, intent (in) :: dt + real(kind_phys), intent (in) :: dt - real, intent (in), dimension (ktop:kbot + 1) :: ze + real(kind_phys), intent (in), dimension (ktop:kbot + 1) :: ze - real, intent (in), dimension (ktop:kbot) :: vt, dp + real(kind_phys), intent (in), dimension (ktop:kbot) :: vt, dp - real, intent (inout), dimension (ktop:kbot) :: q + real(kind_phys), intent (inout), dimension (ktop:kbot) :: q - real, intent (out), dimension (ktop:kbot) :: m1 + real(kind_phys), intent (out), dimension (ktop:kbot) :: m1 - real, intent (out) :: precip + real(kind_phys), intent (out) :: precip - real, dimension (ktop:kbot) :: dz, qm, dd + real(kind_phys), dimension (ktop:kbot) :: dz, qm, dd integer :: k @@ -2955,28 +2956,28 @@ subroutine lagrangian_fall_ppm (ktop, kbot, zs, ze, zt, dp, q, precip, m1, mono) integer, intent (in) :: ktop, kbot - real, intent (in) :: zs + real(kind_phys), intent (in) :: zs logical, intent (in) :: mono - real, intent (in), dimension (ktop:kbot + 1) :: ze, zt + real(kind_phys), intent (in), dimension (ktop:kbot + 1) :: ze, zt - real, intent (in), dimension (ktop:kbot) :: dp + real(kind_phys), intent (in), dimension (ktop:kbot) :: dp ! m1: flux - real, intent (inout), dimension (ktop:kbot) :: q, m1 + real(kind_phys), intent (inout), dimension (ktop:kbot) :: q, m1 - real, intent (out) :: precip + real(kind_phys), intent (out) :: precip - real, dimension (ktop:kbot) :: qm, dz + real(kind_phys), dimension (ktop:kbot) :: qm, dz - real :: a4 (4, ktop:kbot) + real(kind_phys) :: a4 (4, ktop:kbot) - real :: pl, pr, delz, esl + real(kind_phys) :: pl, pr, delz, esl integer :: k, k0, n, m - real, parameter :: r3 = 1. / 3., r23 = 2. / 3. + real(kind_phys), parameter :: r3 = 1. / 3., r23 = 2. / 3. ! ----------------------------------------------------------------------- ! density: @@ -3055,19 +3056,19 @@ subroutine cs_profile (a4, del, km, do_mono) integer, intent (in) :: km ! vertical dimension - real, intent (in) :: del (km) + real(kind_phys), intent (in) :: del (km) logical, intent (in) :: do_mono - real, intent (inout) :: a4 (4, km) + real(kind_phys), intent (inout) :: a4 (4, km) - real, parameter :: qp_min = 1.e-6 + real(kind_phys), parameter :: qp_min = 1.e-6 - real :: gam (km) - real :: q (km + 1) - real :: d4, bet, a_bot, grat, pmp, lac - real :: pmp_1, lac_1, pmp_2, lac_2 - real :: da1, da2, a6da + real(kind_phys) :: gam (km) + real(kind_phys) :: q (km + 1) + real(kind_phys) :: d4, bet, a_bot, grat, pmp, lac + real(kind_phys) :: pmp_1, lac_1, pmp_2, lac_2 + real(kind_phys) :: da1, da2, a6da integer :: k @@ -3234,9 +3235,9 @@ subroutine cs_limiters (km, a4) integer, intent (in) :: km - real, intent (inout) :: a4 (4, km) ! ppm array + real(kind_phys), intent (inout) :: a4 (4, km) ! ppm array - real, parameter :: r12 = 1. / 12. + real(kind_phys), parameter :: r12 = 1. / 12. integer :: k @@ -3273,36 +3274,36 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) integer, intent (in) :: ktop, kbot - real, intent (in), dimension (ktop:kbot) :: den, qs, qi, qg, ql, tk - real, intent (out), dimension (ktop:kbot) :: vts, vti, vtg + real(kind_phys), intent (in), dimension (ktop:kbot) :: den, qs, qi, qg, ql, tk + real(kind_phys), intent (out), dimension (ktop:kbot) :: vts, vti, vtg ! fall velocity constants: - real, parameter :: thi = 1.0e-8 !< cloud ice threshold for terminal fall - real, parameter :: thg = 1.0e-8 - real, parameter :: ths = 1.0e-8 + real(kind_phys), parameter :: thi = 1.0e-8 !< cloud ice threshold for terminal fall + real(kind_phys), parameter :: thg = 1.0e-8 + real(kind_phys), parameter :: ths = 1.0e-8 ! coefficient for the parameterization of mass weighted fall velocity ! as a function of temperature and IWC. ! Table 1 in Deng and Mace (2008) \cite deng_and_mace_2008. - real, parameter :: aa = - 4.14122e-5 - real, parameter :: bb = - 0.00538922 - real, parameter :: cc = - 0.0516344 - real, parameter :: dd = 0.00216078 - real, parameter :: ee = 1.9714 + real(kind_phys), parameter :: aa = - 4.14122e-5 + real(kind_phys), parameter :: bb = - 0.00538922 + real(kind_phys), parameter :: cc = - 0.0516344 + real(kind_phys), parameter :: dd = 0.00216078 + real(kind_phys), parameter :: ee = 1.9714 ! marshall - palmer constants - real, parameter :: vcons = 6.6280504 - real, parameter :: vcong = 87.2382675 - real, parameter :: vconh = vcong * sqrt (rhoh / rhog) - real, parameter :: norms = 942477796.076938 - real, parameter :: normg = 5026548245.74367 - real, parameter :: normh = pi * rhoh * rnzh + real(kind_phys), parameter :: vcons = 6.6280504 + real(kind_phys), parameter :: vcong = 87.2382675 + real(kind_phys), parameter :: vconh = vcong * sqrt (rhoh / rhog) + real(kind_phys), parameter :: norms = 942477796.076938 + real(kind_phys), parameter :: normg = 5026548245.74367 + real(kind_phys), parameter :: normh = pi * rhoh * rnzh - real, dimension (ktop:kbot) :: qden, tc, rhof + real(kind_phys), dimension (ktop:kbot) :: qden, tc, rhof - real :: vi0 + real(kind_phys) :: vi0 integer :: k @@ -3396,30 +3397,30 @@ subroutine setupm implicit none - real :: gcon, cd, scm3, pisq, act (8) - real :: vdifu, tcond - real :: visk - real :: ch2o, hltf - real :: hlts, hltc, ri50 + real(kind_phys) :: gcon, cd, scm3, pisq, act (8) + real(kind_phys) :: vdifu, tcond + real(kind_phys) :: visk + real(kind_phys) :: ch2o, hltf + real(kind_phys) :: hlts, hltc, ri50 - real, parameter :: gam263 = 1.456943, gam275 = 1.608355, gam290 = 1.827363, & + real(kind_phys), parameter :: gam263 = 1.456943, gam275 = 1.608355, gam290 = 1.827363, & gam325 = 2.54925, gam350 = 3.323363, gam380 = 4.694155, & gam425 = 8.285063, gam450 = 11.631769, gam480 = 17.837789, & gam625 = 184.860962, gam680 = 496.604067 ! intercept parameters -! real, parameter :: rnzr = 8.0e6 ! lin83 -! real, parameter :: rnzs = 3.0e6 ! lin83 -! real, parameter :: rnzg = 4.0e6 ! rh84 +! real(kind_phys), parameter :: rnzr = 8.0e6 ! lin83 +! real(kind_phys), parameter :: rnzs = 3.0e6 ! lin83 +! real(kind_phys), parameter :: rnzg = 4.0e6 ! rh84 ! density parameters -! real, parameter :: rhos = 0.1e3 !< lin83 (snow density; 1 / 10 of water) -! real, parameter :: rhog = 0.4e3 !< rh84 (graupel density) - real, parameter :: acc (3) = (/ 5.0, 2.0, 0.5 /) +! real(kind_phys), parameter :: rhos = 0.1e3 !< lin83 (snow density; 1 / 10 of water) +! real(kind_phys), parameter :: rhog = 0.4e3 !< rh84 (graupel density) + real(kind_phys), parameter :: acc (3) = (/ 5.0, 2.0, 0.5 /) - real den_rc + real(kind_phys) den_rc integer :: i, k @@ -3587,7 +3588,7 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo ! integer :: unit, io, ierr, k, logunit ! logical :: flag - ! real :: tmp, q1, q2 + ! real(kind_phys) :: tmp, q1, q2 ! master = (mpp_pe () .eq.mpp_root_pe ()) @@ -3748,19 +3749,19 @@ end subroutine setup_con !! \cite lin_et_al_1983 ) ! ======================================================================= -real function acr3d (v1, v2, q1, q2, c, cac, rho) +real(kind_phys) function acr3d (v1, v2, q1, q2, c, cac, rho) implicit none - real, intent (in) :: v1, v2, c, rho - real, intent (in) :: q1, q2 ! mixing ratio!!! - real, intent (in) :: cac (3) + real(kind_phys), intent (in) :: v1, v2, c, rho + real(kind_phys), intent (in) :: q1, q2 ! mixing ratio!!! + real(kind_phys), intent (in) :: cac (3) - real :: t1, s1, s2 + real(kind_phys) :: t1, s1, s2 ! integer :: k ! - ! real :: a + ! real(kind_phys) :: a ! ! a = 0.0 ! do k = 1, 3 @@ -3783,11 +3784,11 @@ end function acr3d !! note: psacw and psacr must be calc before smlt is called ! ======================================================================= -real function smlt (tc, dqs, qsrho, psacw, psacr, c, rho, rhofac) +real(kind_phys) function smlt (tc, dqs, qsrho, psacw, psacr, c, rho, rhofac) implicit none - real, intent (in) :: tc, dqs, qsrho, psacw, psacr, c (5), rho, rhofac + real(kind_phys), intent (in) :: tc, dqs, qsrho, psacw, psacr, c (5), rho, rhofac smlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qsrho) + & c (4) * qsrho ** 0.65625 * sqrt (rhofac)) + c (5) * tc * (psacw + psacr) @@ -3799,11 +3800,11 @@ end function smlt !!\n note: \f$P_{gacw}\f$ and \f$P_{gacr}\f$ must be calculated before gmlt is called. ! ======================================================================= -real function gmlt (tc, dqs, qgrho, pgacw, pgacr, c, rho) +real(kind_phys) function gmlt (tc, dqs, qgrho, pgacw, pgacr, c, rho) implicit none - real, intent (in) :: tc, dqs, qgrho, pgacw, pgacr, c (5), rho + real(kind_phys), intent (in) :: tc, dqs, qgrho, pgacw, pgacr, c (5), rho gmlt = (c (1) * tc / rho - c (2) * dqs) * (c (3) * sqrt (qgrho) + & c (4) * qgrho ** 0.6875 / rho ** 0.25) + c (5) * tc * (pgacw + pgacr) @@ -3878,16 +3879,16 @@ end subroutine qsmith_init !>\ingroup mod_gfdl_cloud_mp !>@brief The function 'wqs1' returns the saturation vapor pressure over pure !! liquid water for a given temperature and air density. -real function wqs1 (ta, den) +real(kind_phys) function wqs1 (ta, den) implicit none !> pure water phase; universal dry / moist formular using air density !> input "den" can be either dry or moist air density - real, intent (in) :: ta, den + real(kind_phys), intent (in) :: ta, den - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -3907,18 +3908,18 @@ end function wqs1 !! analytic dqs/dT: rate of change of saturation vapor pressure WRT temperature. ! ======================================================================= -real function wqs2 (ta, den, dqdt) +real(kind_phys) function wqs2 (ta, den, dqdt) implicit none ! pure water phase; universal dry / moist formular using air density ! input "den" can be either dry or moist air density - real, intent (in) :: ta, den + real(kind_phys), intent (in) :: ta, den - real, intent (out) :: dqdt + real(kind_phys), intent (out) :: dqdt - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -3943,13 +3944,13 @@ end function wqs2 !! from the mixing ratio and the temperature. ! ======================================================================= -real function wet_bulb (q, t, den) +real(kind_phys) function wet_bulb (q, t, den) implicit none - real, intent (in) :: t, q, den + real(kind_phys), intent (in) :: t, q, den - real :: qs, tp, dqdt + real(kind_phys) :: qs, tp, dqdt wet_bulb = t qs = wqs2 (wet_bulb, den, dqdt) @@ -3970,16 +3971,16 @@ end function wet_bulb !! for table iii ! ======================================================================= -real function iqs1 (ta, den) +real(kind_phys) function iqs1 (ta, den) implicit none !> water - ice phase; universal dry / moist formular using air density !> input "den" can be either dry or moist air density - real, intent (in) :: ta, den + real(kind_phys), intent (in) :: ta, den - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -3997,18 +3998,18 @@ end function iqs1 !! humidity for table iii ! ======================================================================= -real function iqs2 (ta, den, dqdt) +real(kind_phys) function iqs2 (ta, den, dqdt) implicit none ! water - ice phase; universal dry / moist formular using air density ! input "den" can be either dry or moist air density - real, intent (in) :: ta, den + real(kind_phys), intent (in) :: ta, den - real, intent (out) :: dqdt + real(kind_phys), intent (out) :: dqdt - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -4028,15 +4029,15 @@ end function iqs2 !! specific humidity for table iii. ! ======================================================================= -real function qs1d_moist (ta, qv, pa, dqdt) +real(kind_phys) function qs1d_moist (ta, qv, pa, dqdt) implicit none - real, intent (in) :: ta, pa, qv + real(kind_phys), intent (in) :: ta, pa, qv - real, intent (out) :: dqdt + real(kind_phys), intent (out) :: dqdt - real :: es, ap1, tmin, eps10 + real(kind_phys) :: es, ap1, tmin, eps10 integer :: it @@ -4058,15 +4059,15 @@ end function qs1d_moist !! for pure liquid water , as well as des/dT. ! ======================================================================= -real function wqsat2_moist (ta, qv, pa, dqdt) +real(kind_phys) function wqsat2_moist (ta, qv, pa, dqdt) implicit none - real, intent (in) :: ta, pa, qv + real(kind_phys), intent (in) :: ta, pa, qv - real, intent (out) :: dqdt + real(kind_phys), intent (out) :: dqdt - real :: es, ap1, tmin, eps10 + real(kind_phys) :: es, ap1, tmin, eps10 integer :: it @@ -4088,13 +4089,13 @@ end function wqsat2_moist !! for pure liquid water. ! ======================================================================= -real function wqsat_moist (ta, qv, pa) +real(kind_phys) function wqsat_moist (ta, qv, pa) implicit none - real, intent (in) :: ta, pa, qv + real(kind_phys), intent (in) :: ta, pa, qv - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -4112,13 +4113,13 @@ end function wqsat_moist !! for table iii ! ======================================================================= -real function qs1d_m (ta, qv, pa) +real(kind_phys) function qs1d_m (ta, qv, pa) implicit none - real, intent (in) :: ta, pa, qv + real(kind_phys), intent (in) :: ta, pa, qv - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -4136,13 +4137,13 @@ end function qs1d_m !! vapor * density * between water and ice ! ======================================================================= -real function d_sat (ta, den) +real(kind_phys) function d_sat (ta, den) implicit none - real, intent (in) :: ta, den + real(kind_phys), intent (in) :: ta, den - real :: es_w, es_i, ap1, tmin + real(kind_phys) :: es_w, es_i, ap1, tmin integer :: it @@ -4161,13 +4162,13 @@ end function d_sat !! pressure for table ii ! ======================================================================= -real function esw_table (ta) +real(kind_phys) function esw_table (ta) implicit none - real, intent (in) :: ta + real(kind_phys), intent (in) :: ta - real :: ap1, tmin + real(kind_phys) :: ap1, tmin integer :: it @@ -4184,13 +4185,13 @@ end function esw_table !! vapor pressure for table iii ! ======================================================================= -real function es2_table (ta) +real(kind_phys) function es2_table (ta) implicit none - real, intent (in) :: ta + real(kind_phys), intent (in) :: ta - real :: ap1, tmin + real(kind_phys) :: ap1, tmin integer :: it @@ -4212,11 +4213,11 @@ subroutine esw_table1d (ta, es, n) integer, intent (in) :: n - real, intent (in) :: ta (n) + real(kind_phys), intent (in) :: ta (n) - real, intent (out) :: es (n) + real(kind_phys), intent (out) :: es (n) - real :: ap1, tmin + real(kind_phys) :: ap1, tmin integer :: i, it @@ -4241,11 +4242,11 @@ subroutine es2_table1d (ta, es, n) integer, intent (in) :: n - real, intent (in) :: ta (n) + real(kind_phys), intent (in) :: ta (n) - real, intent (out) :: es (n) + real(kind_phys), intent (out) :: es (n) - real :: ap1, tmin + real(kind_phys) :: ap1, tmin integer :: i, it @@ -4270,11 +4271,11 @@ subroutine es3_table1d (ta, es, n) integer, intent (in) :: n - real, intent (in) :: ta (n) + real(kind_phys), intent (in) :: ta (n) - real, intent (out) :: es (n) + real(kind_phys), intent (out) :: es (n) - real :: ap1, tmin + real(kind_phys) :: ap1, tmin integer :: i, it @@ -4299,8 +4300,8 @@ subroutine qs_tablew (n) integer, intent (in) :: n - real :: delt = 0.1 - real :: tmin, tem, fac0, fac1, fac2 + real(kind_phys) :: delt = 0.1 + real(kind_phys) :: tmin, tem, fac0, fac1, fac2 integer :: i @@ -4330,8 +4331,8 @@ subroutine qs_table2 (n) integer, intent (in) :: n - real :: delt = 0.1 - real :: tmin, tem0, tem1, fac0, fac1, fac2 + real(kind_phys) :: delt = 0.1 + real(kind_phys) :: tmin, tem0, tem1, fac0, fac1, fac2 integer :: i, i0, i1 @@ -4379,9 +4380,9 @@ subroutine qs_table3 (n) integer, intent (in) :: n - real :: delt = 0.1 - real :: esbasw, tbasw, esbasi, tmin, tem, aa, b, c, d, e - real :: tem0, tem1 + real(kind_phys) :: delt = 0.1 + real(kind_phys) :: esbasw, tbasw, esbasi, tmin, tem, aa, b, c, d, e + real(kind_phys) :: tem0, tem1 integer :: i, i0, i1 @@ -4399,9 +4400,9 @@ subroutine qs_table3 (n) ! see smithsonian meteorological tables page 350. ! ----------------------------------------------------------------------- aa = - 9.09718 * (table_ice / tem - 1.) - b = - 3.56654 * alog10 (table_ice / tem) + b = - 3.56654 * log10 (table_ice / tem) c = 0.876793 * (1. - tem / table_ice) - e = alog10 (esbasi) + e = log10 (esbasi) table3 (i) = 0.1 * 10 ** (aa + b + c + e) else ! ----------------------------------------------------------------------- @@ -4409,10 +4410,10 @@ subroutine qs_table3 (n) ! see smithsonian meteorological tables page 350. ! ----------------------------------------------------------------------- aa = - 7.90298 * (tbasw / tem - 1.) - b = 5.02808 * alog10 (tbasw / tem) + b = 5.02808 * log10 (tbasw / tem) c = - 1.3816e-7 * (10 ** ((1. - tem / tbasw) * 11.344) - 1.) d = 8.1328e-3 * (10 ** ((tbasw / tem - 1.) * (- 3.49149)) - 1.) - e = alog10 (esbasw) + e = log10 (esbasw) table3 (i) = 0.1 * 10 ** (aa + b + c + d + e) endif enddo @@ -4436,13 +4437,13 @@ end subroutine qs_table3 !>\ingroup mod_gfdl_cloud_mp !! The function 'qs_blend' computes the saturated specific humidity !! with a blend of water and ice depending on the temperature. -real function qs_blend (t, p, q) +real(kind_phys) function qs_blend (t, p, q) implicit none - real, intent (in) :: t, p, q + real(kind_phys), intent (in) :: t, p, q - real :: es, ap1, tmin + real(kind_phys) :: es, ap1, tmin integer :: it @@ -4465,10 +4466,10 @@ subroutine qs_table (n) integer, intent (in) :: n - real :: delt = 0.1 - real :: tmin, tem, esh20 - real :: wice, wh2o, fac0, fac1, fac2 - real :: esupc (200) + real(kind_phys) :: delt = 0.1 + real(kind_phys) :: tmin, tem, esh20 + real(kind_phys) :: wice, wh2o, fac0, fac1, fac2 + real(kind_phys) :: esupc (200) integer :: i @@ -4529,15 +4530,15 @@ subroutine qsmith (im, km, ks, t, p, q, qs, dqdt) integer, intent (in) :: im, km, ks - real, intent (in), dimension (im, km) :: t, p, q + real(kind_phys), intent (in), dimension (im, km) :: t, p, q - real, intent (out), dimension (im, km) :: qs + real(kind_phys), intent (out), dimension (im, km) :: qs - real, intent (out), dimension (im, km), optional :: dqdt + real(kind_phys), intent (out), dimension (im, km), optional :: dqdt - real :: eps10, ap1, tmin + real(kind_phys) :: eps10, ap1, tmin - real, dimension (im, km) :: es + real(kind_phys), dimension (im, km) :: es integer :: i, k, it @@ -4581,13 +4582,13 @@ subroutine neg_adj (ktop, kbot, pt, dp, qv, ql, qr, qi, qs, qg) integer, intent (in) :: ktop, kbot - real, intent (in), dimension (ktop:kbot) :: dp + real(kind_phys), intent (in), dimension (ktop:kbot) :: dp - real, intent (inout), dimension (ktop:kbot) :: pt, qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ktop:kbot) :: pt, qv, ql, qr, qi, qs, qg - real, dimension (ktop:kbot) :: lcpk, icpk + real(kind_phys), dimension (ktop:kbot) :: lcpk, icpk - real :: dq, cvm + real(kind_phys) :: dq, cvm integer :: k @@ -4670,7 +4671,7 @@ end subroutine neg_adj !>@brief quick local sum algorithm ! ======================================================================= -!real function g_sum (p, ifirst, ilast, jfirst, jlast, area, mode) +!real(kind_phys) function g_sum (p, ifirst, ilast, jfirst, jlast, area, mode) ! ! use mpp_mod, only: mpp_sum ! @@ -4679,11 +4680,11 @@ end subroutine neg_adj ! integer, intent (in) :: ifirst, ilast, jfirst, jlast ! integer, intent (in) :: mode ! if == 1 divided by area ! -! real, intent (in), dimension (ifirst:ilast, jfirst:jlast) :: p, area +! real(kind_phys), intent (in), dimension (ifirst:ilast, jfirst:jlast) :: p, area ! ! integer :: i, j ! -! real :: gsum +! real(kind_phys) :: gsum ! ! if (global_area < 0.) then ! global_area = 0. @@ -4720,15 +4721,15 @@ subroutine interpolate_z (is, ie, js, je, km, zl, hgt, a3, a2) integer, intent (in) :: is, ie, js, je, km - real, intent (in), dimension (is:ie, js:je, km) :: a3 + real(kind_phys), intent (in), dimension (is:ie, js:je, km) :: a3 - real, intent (in), dimension (is:ie, js:je, km + 1) :: hgt ! hgt (k) > hgt (k + 1) + real(kind_phys), intent (in), dimension (is:ie, js:je, km + 1) :: hgt ! hgt (k) > hgt (k + 1) - real, intent (in) :: zl + real(kind_phys), intent (in) :: zl - real, intent (out), dimension (is:ie, js:je) :: a2 + real(kind_phys), intent (out), dimension (is:ie, js:je) :: a2 - real, dimension (km) :: zm !< middle layer height + real(kind_phys), dimension (km) :: zm !< middle layer height integer :: i, j, k @@ -4770,24 +4771,24 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, integer, intent (in) :: is, ie, ks, ke integer, intent (in), dimension (is:ie) :: lsm ! land sea mask, 0: ocean, 1: land, 2: sea ice - real, intent (in), dimension (is:ie, ks:ke) :: den, delp, t - real, intent (in), dimension (is:ie, ks:ke) :: qmw, qmi, qmr, qms, qmg !< units: kg / kg + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: den, delp, t + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: qmw, qmi, qmr, qms, qmg !< units: kg / kg - real, intent (out), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg !< units: micron + real(kind_phys), intent (out), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg !< units: micron - real, dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg !< units: g / m^2 + real(kind_phys), dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg !< units: g / m^2 integer :: i, k - real :: lambdar, lambdas, lambdag - real :: dpg, rei_fac, mask, ccn, bw - real, parameter :: rho_0 = 50.e-3 + real(kind_phys) :: lambdar, lambdas, lambdag + real(kind_phys) :: dpg, rei_fac, mask, ccn, bw + real(kind_phys), parameter :: rho_0 = 50.e-3 - real :: rhow = 1.0e3, rhor = 1.0e3, rhos = 1.0e2, rhog = 4.0e2 - real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 - real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 - real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 + real(kind_phys) :: rhow = 1.0e3, rhor = 1.0e3, rhos = 1.0e2, rhog = 4.0e2 + real(kind_phys) :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 + real(kind_phys) :: alphar = 0.8, alphas = 0.25, alphag = 0.5 + real(kind_phys) :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 + real(kind_phys) :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 do k = ks, ke do i = is, ie @@ -4912,21 +4913,21 @@ subroutine refl10cm_gfdl (qv1d, qr1d, qs1d, qg1d, & !..Sub arguments INTEGER, INTENT(IN):: kts, kte, ii,jj - REAL, DIMENSION(kts:kte), INTENT(IN):: & + real(kind_phys), DIMENSION(kts:kte), INTENT(IN):: & qv1d, qr1d, qs1d, qg1d, t1d, p1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ + real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: dBZ !..Local variables - REAL, DIMENSION(kts:kte):: temp, pres, qv, rho - REAL, DIMENSION(kts:kte):: rr, rs, rg -! REAL:: temp_C + real(kind_phys), DIMENSION(kts:kte):: temp, pres, qv, rho + real(kind_phys), DIMENSION(kts:kte):: rr, rs, rg +! real(kind_phys):: temp_C DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilams, ilamg DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_s, N0_g DOUBLE PRECISION:: lamr, lams, lamg LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg - REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel + real(kind_phys), DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel DOUBLE PRECISION:: fmelt_s, fmelt_g INTEGER:: i, k, k_0, kbot, n diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b828c9ab0..38d1d14fd 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -76,14 +76,14 @@ MODULE module_mp_thompson LOGICAL, PARAMETER, PRIVATE:: homogIce = .true. INTEGER, PARAMETER, PRIVATE:: IFDRY = 0 - REAL, PARAMETER, PRIVATE:: T_0 = 273.15 - REAL, PARAMETER, PRIVATE:: PI = 3.1415926536 + REAL(kind_phys), PARAMETER, PRIVATE:: T_0 = 273.15 + REAL(kind_phys), PARAMETER, PRIVATE:: PI = 3.1415926536 !..Densities of rain, snow, graupel, and cloud ice. - REAL, PARAMETER, PRIVATE:: rho_w = 1000.0 - REAL, PARAMETER, PRIVATE:: rho_s = 100.0 - REAL, PARAMETER, PRIVATE:: rho_g = 500.0 - REAL, PARAMETER, PRIVATE:: rho_i = 890.0 + REAL(kind_phys), PARAMETER, PRIVATE:: rho_w = 1000.0 + REAL(kind_phys), PARAMETER, PRIVATE:: rho_s = 100.0 + REAL(kind_phys), PARAMETER, PRIVATE:: rho_g = 500.0 + REAL(kind_phys), PARAMETER, PRIVATE:: rho_i = 890.0 !..Prescribed number of cloud droplets. Set according to known data or !.. roughly 100 per cc (100.E6 m^-3) for Maritime cases and @@ -92,142 +92,142 @@ MODULE module_mp_thompson !.. scheme. In 2-moment cloud water, Nt_c represents a maximum of !.. droplet concentration and nu_c is also variable depending on local !.. droplet number concentration. - !REAL, PARAMETER :: Nt_c = 100.E6 - REAL, PARAMETER :: Nt_c_o = 50.E6 - REAL, PARAMETER :: Nt_c_l = 100.E6 - REAL, PARAMETER, PRIVATE:: Nt_c_max = 1999.E6 + !REAL(kind_phys), PARAMETER :: Nt_c = 100.E6 + REAL(kind_phys), PARAMETER :: Nt_c_o = 50.E6 + REAL(kind_phys), PARAMETER :: Nt_c_l = 100.E6 + REAL(kind_phys), PARAMETER, PRIVATE:: Nt_c_max = 1999.E6 !..Declaration of constants for assumed CCN/IN aerosols when none in !.. the input data. Look inside the init routine for modifications !.. due to surface land-sea points or vegetation characteristics. - REAL, PARAMETER :: naIN0 = 1.5E6 - REAL, PARAMETER :: naIN1 = 0.5E6 - REAL, PARAMETER :: naCCN0 = 300.0E6 - REAL, PARAMETER :: naCCN1 = 50.0E6 + REAL(kind_phys), PARAMETER :: naIN0 = 1.5E6 + REAL(kind_phys), PARAMETER :: naIN1 = 0.5E6 + REAL(kind_phys), PARAMETER :: naCCN0 = 300.0E6 + REAL(kind_phys), PARAMETER :: naCCN1 = 50.0E6 !..Generalized gamma distributions for rain, graupel and cloud ice. !.. N(D) = N_0 * D**mu * exp(-lamda*D); mu=0 is exponential. - REAL, PARAMETER, PRIVATE:: mu_r = 0.0 - REAL, PARAMETER, PRIVATE:: mu_g = 0.0 - REAL, PARAMETER, PRIVATE:: mu_i = 0.0 - REAL, PRIVATE:: mu_c_o, mu_c_l + REAL(kind_phys), PARAMETER, PRIVATE:: mu_r = 0.0 + REAL(kind_phys), PARAMETER, PRIVATE:: mu_g = 0.0 + REAL(kind_phys), PARAMETER, PRIVATE:: mu_i = 0.0 + REAL(kind_phys), PRIVATE:: mu_c_o, mu_c_l !..Sum of two gamma distrib for snow (Field et al. 2005). !.. N(D) = M2**4/M3**3 * [Kap0*exp(-M2*Lam0*D/M3) !.. + Kap1*(M2/M3)**mu_s * D**mu_s * exp(-M2*Lam1*D/M3)] !.. M2 and M3 are the (bm_s)th and (bm_s+1)th moments respectively !.. calculated as function of ice water content and temperature. - REAL, PARAMETER, PRIVATE:: mu_s = 0.6357 - REAL, PARAMETER, PRIVATE:: Kap0 = 490.6 - REAL, PARAMETER, PRIVATE:: Kap1 = 17.46 - REAL, PARAMETER, PRIVATE:: Lam0 = 20.78 - REAL, PARAMETER, PRIVATE:: Lam1 = 3.29 + REAL(kind_phys), PARAMETER, PRIVATE:: mu_s = 0.6357 + REAL(kind_phys), PARAMETER, PRIVATE:: Kap0 = 490.6 + REAL(kind_phys), PARAMETER, PRIVATE:: Kap1 = 17.46 + REAL(kind_phys), PARAMETER, PRIVATE:: Lam0 = 20.78 + REAL(kind_phys), PARAMETER, PRIVATE:: Lam1 = 3.29 !..Y-intercept parameter for graupel is not constant and depends on !.. mixing ratio. Also, when mu_g is non-zero, these become equiv !.. y-intercept for an exponential distrib and proper values are !.. computed based on same mixing ratio and total number concentration. - REAL, PARAMETER, PRIVATE:: gonv_min = 1.E2 - REAL, PARAMETER, PRIVATE:: gonv_max = 1.E6 + REAL(kind_phys), PARAMETER, PRIVATE:: gonv_min = 1.E2 + REAL(kind_phys), PARAMETER, PRIVATE:: gonv_max = 1.E6 !..Mass power law relations: mass = am*D**bm !.. Snow from Field et al. (2005), others assume spherical form. - REAL, PARAMETER, PRIVATE:: am_r = PI*rho_w/6.0 - REAL, PARAMETER, PRIVATE:: bm_r = 3.0 - REAL, PARAMETER, PRIVATE:: am_s = 0.069 - REAL, PARAMETER, PRIVATE:: bm_s = 2.0 - REAL, PARAMETER, PRIVATE:: am_g = PI*rho_g/6.0 - REAL, PARAMETER, PRIVATE:: bm_g = 3.0 - REAL, PARAMETER, PRIVATE:: am_i = PI*rho_i/6.0 - REAL, PARAMETER, PRIVATE:: bm_i = 3.0 + REAL(kind_phys), PARAMETER, PRIVATE:: am_r = PI*rho_w/6.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bm_r = 3.0 + REAL(kind_phys), PARAMETER, PRIVATE:: am_s = 0.069 + REAL(kind_phys), PARAMETER, PRIVATE:: bm_s = 2.0 + REAL(kind_phys), PARAMETER, PRIVATE:: am_g = PI*rho_g/6.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bm_g = 3.0 + REAL(kind_phys), PARAMETER, PRIVATE:: am_i = PI*rho_i/6.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bm_i = 3.0 !..Fallspeed power laws relations: v = (av*D**bv)*exp(-fv*D) !.. Rain from Ferrier (1994), ice, snow, and graupel from !.. Thompson et al (2008). Coefficient fv is zero for graupel/ice. - REAL, PARAMETER, PRIVATE:: av_r = 4854.0 - REAL, PARAMETER, PRIVATE:: bv_r = 1.0 - REAL, PARAMETER, PRIVATE:: fv_r = 195.0 - REAL, PARAMETER, PRIVATE:: av_s = 40.0 - REAL, PARAMETER, PRIVATE:: bv_s = 0.55 - REAL, PARAMETER, PRIVATE:: fv_s = 100.0 - REAL, PARAMETER, PRIVATE:: av_g = 442.0 - REAL, PARAMETER, PRIVATE:: bv_g = 0.89 - REAL, PARAMETER, PRIVATE:: bv_i = 1.0 - REAL, PARAMETER, PRIVATE:: av_c = 0.316946E8 - REAL, PARAMETER, PRIVATE:: bv_c = 2.0 + REAL(kind_phys), PARAMETER, PRIVATE:: av_r = 4854.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bv_r = 1.0 + REAL(kind_phys), PARAMETER, PRIVATE:: fv_r = 195.0 + REAL(kind_phys), PARAMETER, PRIVATE:: av_s = 40.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bv_s = 0.55 + REAL(kind_phys), PARAMETER, PRIVATE:: fv_s = 100.0 + REAL(kind_phys), PARAMETER, PRIVATE:: av_g = 442.0 + REAL(kind_phys), PARAMETER, PRIVATE:: bv_g = 0.89 + REAL(kind_phys), PARAMETER, PRIVATE:: bv_i = 1.0 + REAL(kind_phys), PARAMETER, PRIVATE:: av_c = 0.316946E8 + REAL(kind_phys), PARAMETER, PRIVATE:: bv_c = 2.0 !..Capacitance of sphere and plates/aggregates: D**3, D**2 - REAL, PARAMETER, PRIVATE:: C_cube = 0.5 - REAL, PARAMETER, PRIVATE:: C_sqrd = 0.15 + REAL(kind_phys), PARAMETER, PRIVATE:: C_cube = 0.5 + REAL(kind_phys), PARAMETER, PRIVATE:: C_sqrd = 0.15 !..Collection efficiencies. Rain/snow/graupel collection of cloud !.. droplets use variables (Ef_rw, Ef_sw, Ef_gw respectively) and !.. get computed elsewhere because they are dependent on stokes !.. number. - REAL, PARAMETER, PRIVATE:: Ef_si = 0.05 - REAL, PARAMETER, PRIVATE:: Ef_rs = 0.95 - REAL, PARAMETER, PRIVATE:: Ef_rg = 0.75 - REAL, PARAMETER, PRIVATE:: Ef_ri = 0.95 + REAL(kind_phys), PARAMETER, PRIVATE:: Ef_si = 0.05 + REAL(kind_phys), PARAMETER, PRIVATE:: Ef_rs = 0.95 + REAL(kind_phys), PARAMETER, PRIVATE:: Ef_rg = 0.75 + REAL(kind_phys), PARAMETER, PRIVATE:: Ef_ri = 0.95 !..Minimum microphys values !.. R1 value, 1.E-12, cannot be set lower because of numerical !.. problems with Paul Field's moments and should not be set larger !.. because of truncation problems in snow/ice growth. - REAL, PARAMETER, PRIVATE:: R1 = 1.E-12 - REAL, PARAMETER, PRIVATE:: R2 = 1.E-6 - REAL, PARAMETER :: eps = 1.E-15 + REAL(kind_phys), PARAMETER, PRIVATE:: R1 = 1.E-12 + REAL(kind_phys), PARAMETER, PRIVATE:: R2 = 1.E-6 + REAL(kind_phys), PARAMETER :: eps = 1.E-15 !..Constants in Cooper curve relation for cloud ice number. - REAL, PARAMETER, PRIVATE:: TNO = 5.0 - REAL, PARAMETER, PRIVATE:: ATO = 0.304 + REAL(kind_phys), PARAMETER, PRIVATE:: TNO = 5.0 + REAL(kind_phys), PARAMETER, PRIVATE:: ATO = 0.304 !..Rho_not used in fallspeed relations (rho_not/rho)**.5 adjustment. - REAL, PARAMETER, PRIVATE:: rho_not = 101325.0/(287.05*298.0) + REAL(kind_phys), PARAMETER, PRIVATE:: rho_not = 101325.0/(287.05*298.0) !..Schmidt number - REAL, PARAMETER, PRIVATE:: Sc = 0.632 - REAL, PRIVATE:: Sc3 + REAL(kind_phys), PARAMETER, PRIVATE:: Sc = 0.632 + REAL(kind_phys), PRIVATE:: Sc3 !..Homogeneous freezing temperature - REAL, PARAMETER, PRIVATE:: HGFR = 235.16 + REAL(kind_phys), PARAMETER, PRIVATE:: HGFR = 235.16 !..Water vapor and air gas constants at constant pressure - REAL, PARAMETER, PRIVATE:: Rv = 461.5 - REAL, PARAMETER, PRIVATE:: oRv = 1./Rv - REAL, PARAMETER, PRIVATE:: R = 287.04 - REAL, PARAMETER, PRIVATE:: Cp = 1004.0 - REAL, PARAMETER, PRIVATE:: R_uni = 8.314 !< J (mol K)-1 + REAL(kind_phys), PARAMETER, PRIVATE:: Rv = 461.5 + REAL(kind_phys), PARAMETER, PRIVATE:: oRv = 1./Rv + REAL(kind_phys), PARAMETER, PRIVATE:: R = 287.04 + REAL(kind_phys), PARAMETER, PRIVATE:: Cp = 1004.0 + REAL(kind_phys), PARAMETER, PRIVATE:: R_uni = 8.314 !< J (mol K)-1 DOUBLE PRECISION, PARAMETER, PRIVATE:: k_b = 1.38065E-23 !< Boltzmann constant [J/K] DOUBLE PRECISION, PARAMETER, PRIVATE:: M_w = 18.01528E-3 !< molecular mass of water [kg/mol] DOUBLE PRECISION, PARAMETER, PRIVATE:: M_a = 28.96E-3 !< molecular mass of air [kg/mol] DOUBLE PRECISION, PARAMETER, PRIVATE:: N_avo = 6.022E23 !< Avogadro number [1/mol] DOUBLE PRECISION, PARAMETER, PRIVATE:: ma_w = M_w / N_avo !< mass of water molecule [kg] - REAL, PARAMETER, PRIVATE:: ar_volume = 4./3.*PI*(2.5e-6)**3 !< assume radius of 0.025 micrometer, 2.5e-6 cm + REAL(kind_phys), PARAMETER, PRIVATE:: ar_volume = 4./3.*PI*(2.5e-6)**3 !< assume radius of 0.025 micrometer, 2.5e-6 cm !..Enthalpy of sublimation, vaporization, and fusion at 0C. - REAL, PARAMETER, PRIVATE:: lsub = 2.834E6 - REAL, PARAMETER, PRIVATE:: lvap0 = 2.5E6 - REAL, PARAMETER, PRIVATE:: lfus = lsub - lvap0 - REAL, PARAMETER, PRIVATE:: olfus = 1./lfus + REAL(kind_phys), PARAMETER, PRIVATE:: lsub = 2.834E6 + REAL(kind_phys), PARAMETER, PRIVATE:: lvap0 = 2.5E6 + REAL(kind_phys), PARAMETER, PRIVATE:: lfus = lsub - lvap0 + REAL(kind_phys), PARAMETER, PRIVATE:: olfus = 1./lfus !..Ice initiates with this mass (kg), corresponding diameter calc. !..Min diameters and mass of cloud, rain, snow, and graupel (m, kg). - REAL, PARAMETER, PRIVATE:: xm0i = 1.E-12 - REAL, PARAMETER, PRIVATE:: D0c = 1.E-6 - REAL, PARAMETER, PRIVATE:: D0r = 50.E-6 - REAL, PARAMETER, PRIVATE:: D0s = 300.E-6 - REAL, PARAMETER, PRIVATE:: D0g = 350.E-6 - REAL, PRIVATE:: D0i, xm0s, xm0g + REAL(kind_phys), PARAMETER, PRIVATE:: xm0i = 1.E-12 + REAL(kind_phys), PARAMETER, PRIVATE:: D0c = 1.E-6 + REAL(kind_phys), PARAMETER, PRIVATE:: D0r = 50.E-6 + REAL(kind_phys), PARAMETER, PRIVATE:: D0s = 300.E-6 + REAL(kind_phys), PARAMETER, PRIVATE:: D0g = 350.E-6 + REAL(kind_phys), PRIVATE:: D0i, xm0s, xm0g !..Min and max radiative effective radius of cloud water, cloud ice, and snow; !.. performed by subroutine calc_effectRad. On purpose, these should stay PUBLIC. - REAL, PARAMETER:: re_qc_min = 2.50E-6 ! 2.5 microns - REAL, PARAMETER:: re_qc_max = 50.0E-6 ! 50 microns - REAL, PARAMETER:: re_qi_min = 2.50E-6 ! 2.5 microns - REAL, PARAMETER:: re_qi_max = 125.0E-6 ! 125 microns - REAL, PARAMETER:: re_qs_min = 5.00E-6 ! 5 microns - REAL, PARAMETER:: re_qs_max = 999.0E-6 ! 999 microns (1 mm) + REAL(kind_phys), PARAMETER:: re_qc_min = 2.50E-6 ! 2.5 microns + REAL(kind_phys), PARAMETER:: re_qc_max = 50.0E-6 ! 50 microns + REAL(kind_phys), PARAMETER:: re_qi_min = 2.50E-6 ! 2.5 microns + REAL(kind_phys), PARAMETER:: re_qi_max = 125.0E-6 ! 125 microns + REAL(kind_phys), PARAMETER:: re_qs_min = 5.00E-6 ! 5 microns + REAL(kind_phys), PARAMETER:: re_qs_max = 999.0E-6 ! 999 microns (1 mm) !..Lookup table dimensions INTEGER, PARAMETER, PRIVATE:: nbins = 100 @@ -263,7 +263,7 @@ MODULE module_mp_thompson DOUBLE PRECISION, DIMENSION(nbc):: t_Nc !> Lookup tables for cloud water content (kg/m**3). - REAL, DIMENSION(ntb_c), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_c), PARAMETER, PRIVATE:: & r_c = (/1.e-6,2.e-6,3.e-6,4.e-6,5.e-6,6.e-6,7.e-6,8.e-6,9.e-6, & 1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, & 1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, & @@ -271,7 +271,7 @@ MODULE module_mp_thompson 1.e-2/) !> Lookup tables for cloud ice content (kg/m**3). - REAL, DIMENSION(ntb_i), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_i), PARAMETER, PRIVATE:: & r_i = (/1.e-10,2.e-10,3.e-10,4.e-10, & 5.e-10,6.e-10,7.e-10,8.e-10,9.e-10, & 1.e-9,2.e-9,3.e-9,4.e-9,5.e-9,6.e-9,7.e-9,8.e-9,9.e-9, & @@ -283,7 +283,7 @@ MODULE module_mp_thompson 1.e-3/) !> Lookup tables for rain content (kg/m**3). - REAL, DIMENSION(ntb_r), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_r), PARAMETER, PRIVATE:: & r_r = (/1.e-6,2.e-6,3.e-6,4.e-6,5.e-6,6.e-6,7.e-6,8.e-6,9.e-6, & 1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, & 1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, & @@ -291,21 +291,21 @@ MODULE module_mp_thompson 1.e-2/) !> Lookup tables for graupel content (kg/m**3). - REAL, DIMENSION(ntb_g), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_g), PARAMETER, PRIVATE:: & r_g = (/1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, & 1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, & 1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, & 1.e-2/) !> Lookup tables for snow content (kg/m**3). - REAL, DIMENSION(ntb_s), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_s), PARAMETER, PRIVATE:: & r_s = (/1.e-5,2.e-5,3.e-5,4.e-5,5.e-5,6.e-5,7.e-5,8.e-5,9.e-5, & 1.e-4,2.e-4,3.e-4,4.e-4,5.e-4,6.e-4,7.e-4,8.e-4,9.e-4, & 1.e-3,2.e-3,3.e-3,4.e-3,5.e-3,6.e-3,7.e-3,8.e-3,9.e-3, & 1.e-2/) !> Lookup tables for rain y-intercept parameter (/m**4). - REAL, DIMENSION(ntb_r1), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_r1), PARAMETER, PRIVATE:: & N0r_exp = (/1.e6,2.e6,3.e6,4.e6,5.e6,6.e6,7.e6,8.e6,9.e6, & 1.e7,2.e7,3.e7,4.e7,5.e7,6.e7,7.e7,8.e7,9.e7, & 1.e8,2.e8,3.e8,4.e8,5.e8,6.e8,7.e8,8.e8,9.e8, & @@ -313,7 +313,7 @@ MODULE module_mp_thompson 1.e10/) !> Lookup tables for graupel y-intercept parameter (/m**4). - REAL, DIMENSION(ntb_g1), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_g1), PARAMETER, PRIVATE:: & N0g_exp = (/1.e2,2.e2,3.e2,4.e2,5.e2,6.e2,7.e2,8.e2,9.e2, & 1.e3,2.e3,3.e3,4.e3,5.e3,6.e3,7.e3,8.e3,9.e3, & 1.e4,2.e4,3.e4,4.e4,5.e4,6.e4,7.e4,8.e4,9.e4, & @@ -321,7 +321,7 @@ MODULE module_mp_thompson 1.e6/) !> Lookup tables for ice number concentration (/m**3). - REAL, DIMENSION(ntb_i1), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_i1), PARAMETER, PRIVATE:: & Nt_i = (/1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0, & 1.e1,2.e1,3.e1,4.e1,5.e1,6.e1,7.e1,8.e1,9.e1, & 1.e2,2.e2,3.e2,4.e2,5.e2,6.e2,7.e2,8.e2,9.e2, & @@ -332,19 +332,19 @@ MODULE module_mp_thompson !..Aerosol table parameter: Number of available aerosols, vertical !.. velocity, temperature, aerosol mean radius, and hygroscopicity. - REAL, DIMENSION(ntb_arc), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_arc), PARAMETER, PRIVATE:: & ta_Na = (/10.0, 31.6, 100.0, 316.0, 1000.0, 3160.0, 10000.0/) - REAL, DIMENSION(ntb_arw), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_arw), PARAMETER, PRIVATE:: & ta_Ww = (/0.01, 0.0316, 0.1, 0.316, 1.0, 3.16, 10.0, 31.6, 100.0/) - REAL, DIMENSION(ntb_art), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_art), PARAMETER, PRIVATE:: & ta_Tk = (/243.15, 253.15, 263.15, 273.15, 283.15, 293.15, 303.15/) - REAL, DIMENSION(ntb_arr), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_arr), PARAMETER, PRIVATE:: & ta_Ra = (/0.01, 0.02, 0.04, 0.08, 0.16/) - REAL, DIMENSION(ntb_ark), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_ark), PARAMETER, PRIVATE:: & ta_Ka = (/0.2, 0.4, 0.6, 0.8/) !> Lookup tables for IN concentration (/m**3) from 0.001 to 1000/Liter. - REAL, DIMENSION(ntb_IN), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_IN), PARAMETER, PRIVATE:: & Nt_IN = (/1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0, & 1.e1,2.e1,3.e1,4.e1,5.e1,6.e1,7.e1,8.e1,9.e1, & 1.e2,2.e2,3.e2,4.e2,5.e2,6.e2,7.e2,8.e2,9.e2, & @@ -354,15 +354,15 @@ MODULE module_mp_thompson 1.e6/) !> For snow moments conversions (from Field et al. 2005) - REAL, DIMENSION(10), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(10), PARAMETER, PRIVATE:: & sa = (/ 5.065339, -0.062659, -3.032362, 0.029469, -0.000285, & 0.31255, 0.000204, 0.003199, 0.0, -0.015952/) - REAL, DIMENSION(10), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(10), PARAMETER, PRIVATE:: & sb = (/ 0.476221, -0.015896, 0.165977, 0.007468, -0.000141, & 0.060366, 0.000079, 0.000594, 0.0, -0.003577/) !> Temperatures (5 C interval 0 to -40) used in lookup tables. - REAL, DIMENSION(ntb_t), PARAMETER, PRIVATE:: & + REAL(kind_phys), DIMENSION(ntb_t), PARAMETER, PRIVATE:: & Tc = (/-0.01, -5., -10., -15., -20., -25., -30., -35., -40./) !..Lookup tables for various accretion/collection terms. @@ -381,44 +381,44 @@ MODULE module_mp_thompson INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8 INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4 - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & tcg_racg, tmr_racg, tcr_gacr, tmg_gacr, & tnr_racg, tnr_gacr - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & tcs_racs1, tmr_racs1, tcs_racs2, tmr_racs2, & tcr_sacr1, tms_sacr1, tcr_sacr2, tms_sacr2, & tnr_racs1, tnr_racs2, tnr_sacr1, tnr_sacr2 - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & tpi_qcfz, tni_qcfz - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & tpi_qrfz, tpg_qrfz, tni_qrfz, tnr_qrfz - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: & tps_iaus, tni_iaus, tpi_ide - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: t_Efrw - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: t_Efsw - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:):: tnr_rev - REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:):: & + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: t_Efrw + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:):: t_Efsw + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:):: tnr_rev + REAL(KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:):: & tpc_wev, tnc_wev - REAL (KIND=R4SIZE), ALLOCATABLE, DIMENSION(:,:,:,:,:):: tnccn_act + REAL(KIND=R4SIZE), ALLOCATABLE, DIMENSION(:,:,:,:,:):: tnccn_act !..Variables holding a bunch of exponents and gamma values (cloud water, !.. cloud ice, rain, snow, then graupel). - REAL, DIMENSION(5,15), PRIVATE:: cce, ccg - REAL, DIMENSION(15), PRIVATE:: ocg1, ocg2 - REAL, DIMENSION(7), PRIVATE:: cie, cig - REAL, PRIVATE:: oig1, oig2, obmi - REAL, DIMENSION(13), PRIVATE:: cre, crg - REAL, PRIVATE:: ore1, org1, org2, org3, obmr - REAL, DIMENSION(18), PRIVATE:: cse, csg - REAL, PRIVATE:: oams, obms, ocms - REAL, DIMENSION(12), PRIVATE:: cge, cgg - REAL, PRIVATE:: oge1, ogg1, ogg2, ogg3, oamg, obmg, ocmg + REAL(kind_phys), DIMENSION(5,15), PRIVATE:: cce, ccg + REAL(kind_phys), DIMENSION(15), PRIVATE:: ocg1, ocg2 + REAL(kind_phys), DIMENSION(7), PRIVATE:: cie, cig + REAL(kind_phys), PRIVATE:: oig1, oig2, obmi + REAL(kind_phys), DIMENSION(13), PRIVATE:: cre, crg + REAL(kind_phys), PRIVATE:: ore1, org1, org2, org3, obmr + REAL(kind_phys), DIMENSION(18), PRIVATE:: cse, csg + REAL(kind_phys), PRIVATE:: oams, obms, ocms + REAL(kind_phys), DIMENSION(12), PRIVATE:: cge, cgg + REAL(kind_phys), PRIVATE:: oge1, ogg1, ogg2, ogg3, oamg, obmg, ocmg !..Declaration of precomputed constants in various rate eqns. - REAL:: t1_qr_qc, t1_qr_qi, t2_qr_qi, t1_qg_qc, t1_qs_qc, t1_qs_qi - REAL:: t1_qr_ev, t2_qr_ev - REAL:: t1_qs_sd, t2_qs_sd, t1_qg_sd, t2_qg_sd - REAL:: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me + REAL(kind_phys):: t1_qr_qc, t1_qr_qi, t2_qr_qi, t1_qg_qc, t1_qs_qc, t1_qs_qi + REAL(kind_phys):: t1_qr_ev, t2_qr_ev + REAL(kind_phys):: t1_qs_sd, t2_qs_sd, t1_qg_sd, t2_qg_sd + REAL(kind_phys):: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me !..MPI communicator INTEGER:: mpi_communicator @@ -455,7 +455,7 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & INTEGER:: i, j, k, l, m, n LOGICAL:: micro_init - real :: stime, etime + real(kind_phys) :: stime, etime LOGICAL, PARAMETER :: precomputed_tables = .FALSE. ! Set module variable is_aerosol_aware/merra2_aerosol_aware @@ -690,15 +690,15 @@ SUBROUTINE thompson_init(is_aerosol_aware_in, & t2_qg_me = PI*4.*C_cube*olfus * 0.28*Sc3*SQRT(av_g) * cgg(11) !> - Compute constants for helping find lookup table indexes - nic2 = NINT(ALOG10(r_c(1))) - nii2 = NINT(ALOG10(r_i(1))) - nii3 = NINT(ALOG10(Nt_i(1))) - nir2 = NINT(ALOG10(r_r(1))) - nir3 = NINT(ALOG10(N0r_exp(1))) - nis2 = NINT(ALOG10(r_s(1))) - nig2 = NINT(ALOG10(r_g(1))) - nig3 = NINT(ALOG10(N0g_exp(1))) - niIN2 = NINT(ALOG10(Nt_IN(1))) + nic2 = NINT(LOG10(r_c(1))) + nii2 = NINT(LOG10(r_i(1))) + nii3 = NINT(LOG10(Nt_i(1))) + nir2 = NINT(LOG10(r_r(1))) + nir3 = NINT(LOG10(N0r_exp(1))) + nis2 = NINT(LOG10(r_s(1))) + nig2 = NINT(LOG10(r_g(1))) + nig3 = NINT(LOG10(N0g_exp(1))) + niIN2 = NINT(LOG10(Nt_IN(1))) !> - Create bins of cloud water (from min diameter up to 100 microns) Dc(1) = D0c*1.0d0 @@ -1030,42 +1030,42 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN):: & pii - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & nc, nwfa, nifa - REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d + REAL(kind_phys), DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN):: lsm - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & re_cloud, re_ice, re_snow - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: pfils, pflls + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: pfils, pflls INTEGER, INTENT(IN) :: rand_perturb_on, kme_stoch, n_var_spp - REAL, DIMENSION(:,:), INTENT(IN) :: rand_pert - REAL, DIMENSION(:), INTENT(IN) :: spp_prt_list, spp_stddev_cutoff + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: rand_pert + REAL(kind_phys), DIMENSION(:), INTENT(IN) :: spp_prt_list, spp_stddev_cutoff CHARACTER(len=3), DIMENSION(:), INTENT(IN) :: spp_var_list INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & rainprod, evapprod #endif - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: & p, w, dz - REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & RAINNC, RAINNCV, SR - REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT):: & SNOWNC, SNOWNCV, & ICENC, ICENCV, & GRAUPELNC, GRAUPELNCV - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & refl_10cm - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & vt_dbz_wt LOGICAL, INTENT(IN) :: first_time_step - REAL, INTENT(IN):: dt_in, dt_inner + REAL(kind_phys), INTENT(IN):: dt_in, dt_inner LOGICAL, INTENT(IN) :: sedi_semi INTEGER, INTENT(IN) :: decfl ! To support subcycling: current step and maximum number of steps @@ -1074,7 +1074,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. LOGICAL, INTENT (IN) :: ext_diag LOGICAL, OPTIONAL, INTENT(IN):: aero_ind_fdb - REAL, DIMENSION(:,:,:), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(:,:,:), INTENT(INOUT):: & !vts1, txri, txrc, & prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & @@ -1091,12 +1091,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nrten3, ncten3, qcten3 !..Local variables - REAL, DIMENSION(kts:kte):: & + REAL(kind_phys), DIMENSION(kts:kte):: & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ, pfil1, pfll1 !..Extended diagnostics, single column arrays - REAL, DIMENSION(:), ALLOCATABLE:: & + REAL(kind_phys), DIMENSION(:), ALLOCATABLE:: & !vtsk1, txri1, txrc1, & prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & @@ -1112,16 +1112,16 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qrten1, qsten1, qgten1, qiten1, niten1, & nrten1, ncten1, qcten1 - REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d + REAL(kind_phys), DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) - REAL, DIMENSION(kts:kte):: & + REAL(kind_phys), DIMENSION(kts:kte):: & rainprod1d, evapprod1d #endif - REAL, DIMENSION(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic - REAL:: dt, pptrain, pptsnow, pptgraul, pptice - REAL:: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max + REAL(kind_phys), DIMENSION(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic + REAL(kind_phys):: dt, pptrain, pptsnow, pptgraul, pptice + REAL(kind_phys):: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max INTEGER:: lsml - REAL:: rand1, rand2, rand3, rand_pert_max + REAL(kind_phys):: rand1, rand2, rand3, rand_pert_max INTEGER:: i, j, k, m INTEGER:: imax_qc,imax_qr,imax_qi,imax_qs,imax_qg,imax_ni,imax_nr INTEGER:: jmax_qc,jmax_qr,jmax_qi,jmax_qs,jmax_qg,jmax_ni,jmax_nr @@ -1881,20 +1881,20 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..Sub arguments INTEGER, INTENT(IN):: kts, kte, ii, jj - REAL, DIMENSION(kts:kte), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, t1d - REAL, DIMENSION(kts:kte), INTENT(OUT):: pfil1, pfll1 - REAL, DIMENSION(kts:kte), INTENT(IN):: p1d, w1d, dzq - REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice - REAL, INTENT(IN):: dt + REAL(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: pfil1, pfll1 + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: p1d, w1d, dzq + REAL(kind_phys), INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice + REAL(kind_phys), INTENT(IN):: dt INTEGER, INTENT(IN):: lsml - REAL, INTENT(IN):: rand1, rand2, rand3 + REAL(kind_phys), INTENT(IN):: rand1, rand2, rand3 ! Extended diagnostics, most arrays only allocated if ext_diag is true LOGICAL, INTENT(IN) :: ext_diag LOGICAL, INTENT(IN) :: sedi_semi INTEGER, INTENT(IN) :: decfl - REAL, DIMENSION(:), INTENT(OUT):: & + REAL(kind_phys), DIMENSION(:), INTENT(OUT):: & !vtsk1, txri1, txrc1, & prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & @@ -1911,12 +1911,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nrten1, ncten1, qcten1 #if ( WRF_CHEM == 1 ) - REAL, DIMENSION(kts:kte), INTENT(INOUT):: & + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod #endif !..Local variables - REAL, DIMENSION(kts:kte):: tten, qvten, qcten, qiten, & + REAL(kind_phys), DIMENSION(kts:kte):: tten, qvten, qcten, qiten, & qrten, qsten, qgten, niten, nrten, ncten, nwfaten, nifaten DOUBLE PRECISION, DIMENSION(kts:kte):: prw_vcd @@ -1949,50 +1949,50 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prg_rcg, prg_ihm DOUBLE PRECISION, PARAMETER:: zeroD0 = 0.0d0 - REAL :: dtcfl,rainsfc,graulsfc + REAL(kind_phys) :: dtcfl,rainsfc,graulsfc INTEGER :: niter - REAL, DIMENSION(kts:kte):: temp, pres, qv, pfll, pfil, pdummy - REAL, DIMENSION(kts:kte):: rc, ri, rr, rs, rg, ni, nr, nc, nwfa, nifa - REAL, DIMENSION(kts:kte):: rr_tmp, nr_tmp, rg_tmp - REAL, DIMENSION(kts:kte):: rho, rhof, rhof2 - REAL, DIMENSION(kts:kte):: qvs, qvsi, delQvs - REAL, DIMENSION(kts:kte):: satw, sati, ssatw, ssati - REAL, DIMENSION(kts:kte):: diffu, visco, vsc2, & + REAL(kind_phys), DIMENSION(kts:kte):: temp, pres, qv, pfll, pfil, pdummy + REAL(kind_phys), DIMENSION(kts:kte):: rc, ri, rr, rs, rg, ni, nr, nc, nwfa, nifa + REAL(kind_phys), DIMENSION(kts:kte):: rr_tmp, nr_tmp, rg_tmp + REAL(kind_phys), DIMENSION(kts:kte):: rho, rhof, rhof2 + REAL(kind_phys), DIMENSION(kts:kte):: qvs, qvsi, delQvs + REAL(kind_phys), DIMENSION(kts:kte):: satw, sati, ssatw, ssati + REAL(kind_phys), DIMENSION(kts:kte):: diffu, visco, vsc2, & tcond, lvap, ocp, lvt2 DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilamg, N0_r, N0_g - REAL, DIMENSION(kts:kte):: mvd_r, mvd_c - REAL, DIMENSION(kts:kte):: smob, smo2, smo1, smo0, & + REAL(kind_phys), DIMENSION(kts:kte):: mvd_r, mvd_c + REAL(kind_phys), DIMENSION(kts:kte):: smob, smo2, smo1, smo0, & smoc, smod, smoe, smof - REAL, DIMENSION(kts:kte):: sed_r, sed_s, sed_g, sed_i, sed_n,sed_c + REAL(kind_phys), DIMENSION(kts:kte):: sed_r, sed_s, sed_g, sed_i, sed_n,sed_c - REAL:: rgvm, delta_tp, orho, lfus2, orhodt - REAL, DIMENSION(5):: onstep + REAL(kind_phys):: rgvm, delta_tp, orho, lfus2, orhodt + REAL(kind_phys), DIMENSION(5):: onstep DOUBLE PRECISION:: N0_exp, N0_min, lam_exp, lamc, lamr, lamg DOUBLE PRECISION:: lami, ilami, ilamc - REAL:: xDc, Dc_b, Dc_g, xDi, xDr, xDs, xDg, Ds_m, Dg_m + REAL(kind_phys):: xDc, Dc_b, Dc_g, xDi, xDr, xDs, xDg, Ds_m, Dg_m DOUBLE PRECISION:: Dr_star, Dc_star - REAL:: zeta1, zeta, taud, tau - REAL:: stoke_r, stoke_s, stoke_g, stoke_i - REAL:: vti, vtr, vts, vtg, vtc - REAL, DIMENSION(kts:kte+1):: vtik, vtnik, vtrk, vtnrk, vtsk, vtgk, & + REAL(kind_phys):: zeta1, zeta, taud, tau + REAL(kind_phys):: stoke_r, stoke_s, stoke_g, stoke_i + REAL(kind_phys):: vti, vtr, vts, vtg, vtc + REAL(kind_phys), DIMENSION(kts:kte+1):: vtik, vtnik, vtrk, vtnrk, vtsk, vtgk, & vtck, vtnck - REAL, DIMENSION(kts:kte):: vts_boost - REAL:: Mrat, ils1, ils2, t1_vts, t2_vts, t3_vts, t4_vts, C_snow - REAL:: a_, b_, loga_, A1, A2, tf - REAL:: tempc, tc0, r_mvd1, r_mvd2, xkrat - REAL:: xnc, xri, xni, xmi, oxmi, xrc, xrr, xnr - REAL:: xsat, rate_max, sump, ratio - REAL:: clap, fcd, dfcd - REAL:: otemp, rvs, rvs_p, rvs_pp, gamsc, alphsc, t1_evap, t1_subl - REAL:: r_frac, g_frac - REAL:: Ef_rw, Ef_sw, Ef_gw, Ef_rr - REAL:: Ef_ra, Ef_sa, Ef_ga - REAL:: dtsave, odts, odt, odzq, hgt_agl, SR - REAL:: xslw1, ygra1, zans1, eva_factor - REAL:: av_i + REAL(kind_phys), DIMENSION(kts:kte):: vts_boost + REAL(kind_phys):: Mrat, ils1, ils2, t1_vts, t2_vts, t3_vts, t4_vts, C_snow + REAL(kind_phys):: a_, b_, loga_, A1, A2, tf + REAL(kind_phys):: tempc, tc0, r_mvd1, r_mvd2, xkrat + REAL(kind_phys):: xnc, xri, xni, xmi, oxmi, xrc, xrr, xnr + REAL(kind_phys):: xsat, rate_max, sump, ratio + REAL(kind_phys):: clap, fcd, dfcd + REAL(kind_phys):: otemp, rvs, rvs_p, rvs_pp, gamsc, alphsc, t1_evap, t1_subl + REAL(kind_phys):: r_frac, g_frac + REAL(kind_phys):: Ef_rw, Ef_sw, Ef_gw, Ef_rr + REAL(kind_phys):: Ef_ra, Ef_sa, Ef_ga + REAL(kind_phys):: dtsave, odts, odt, odzq, hgt_agl, SR + REAL(kind_phys):: xslw1, ygra1, zans1, eva_factor + REAL(kind_phys):: av_i INTEGER:: i, k, k2, n, nn, nstep, k_0, kbot, IT, iexfrq INTEGER, DIMENSION(5):: ksed1 INTEGER:: nir, nis, nig, nii, nic, niin @@ -2329,11 +2329,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !! Bohren & Albrecht 1998; others from Pruppacher & Klett 1978. !+---+-----------------------------------------------------------------+ do k = kts, kte - tempc = temp(k) - 273.15 + tempc = temp(k) - 273.15_kind_phys rhof(k) = SQRT(RHO_NOT/rho(k)) rhof2(k) = SQRT(rhof(k)) qvs(k) = rslf(pres(k), temp(k)) - delQvs(k) = MAX(0.0, rslf(pres(k), 273.15)-qv(k)) + delQvs(k) = MAX(0.0, rslf(pres(k), 273.15_kind_phys)-qv(k)) if (tempc .le. 0.0) then qvsi(k) = rsif(pres(k), temp(k)) else @@ -2457,7 +2457,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) + ygra1 = log10(max(1.E-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) @@ -2541,13 +2541,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Rain collecting aerosols, wet scavenging. if (L_qr(k) .and. mvd_r(k).gt. D0r) then - Ef_ra = Eff_aero(mvd_r(k),0.04E-6,visco(k),rho(k),temp(k),'r') + Ef_ra = Eff_aero(mvd_r(k),0.04E-6_kind_phys,visco(k),rho(k),temp(k),'r') lamr = 1./ilamr(k) pna_rca(k) = rhof(k)*t1_qr_qc*Ef_ra*nwfa(k)*N0_r(k) & *((lamr+fv_r)**(-cre(9))) pna_rca(k) = MIN(DBLE(nwfa(k)*odts), pna_rca(k)) - Ef_ra = Eff_aero(mvd_r(k),0.8E-6,visco(k),rho(k),temp(k),'r') + Ef_ra = Eff_aero(mvd_r(k),0.8E-6_kind_phys,visco(k),rho(k),temp(k),'r') pnd_rcd(k) = rhof(k)*t1_qr_qc*Ef_ra*nifa(k)*N0_r(k) & *((lamr+fv_r)**(-cre(9))) pnd_rcd(k) = MIN(DBLE(nifa(k)*odts), pnd_rcd(k)) @@ -2574,7 +2574,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Cloud water lookup table index. if (rc(k).gt. r_c(1)) then - nic = NINT(ALOG10(rc(k))) + nic = NINT(LOG10(rc(k))) do nn = nic-1, nic+1 n = nn if ( (rc(k)/10.**nn).ge.1.0 .and. & @@ -2593,7 +2593,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Cloud ice lookup table indexes. if (ri(k).gt. r_i(1)) then - nii = NINT(ALOG10(ri(k))) + nii = NINT(LOG10(ri(k))) do nn = nii-1, nii+1 n = nn if ( (ri(k)/10.**nn).ge.1.0 .and. & @@ -2607,7 +2607,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & endif if (ni(k).gt. Nt_i(1)) then - nii = NINT(ALOG10(ni(k))) + nii = NINT(LOG10(ni(k))) do nn = nii-1, nii+1 n = nn if ( (ni(k)/10.**nn).ge.1.0 .and. & @@ -2622,7 +2622,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Rain lookup table indexes. if (rr(k).gt. r_r(1)) then - nir = NINT(ALOG10(rr(k))) + nir = NINT(LOG10(rr(k))) do nn = nir-1, nir+1 n = nn if ( (rr(k)/10.**nn).ge.1.0 .and. & @@ -2651,7 +2651,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Snow lookup table index. if (rs(k).gt. r_s(1)) then - nis = NINT(ALOG10(rs(k))) + nis = NINT(LOG10(rs(k))) do nn = nis-1, nis+1 n = nn if ( (rs(k)/10.**nn).ge.1.0 .and. & @@ -2666,7 +2666,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Graupel lookup table index. if (rg(k).gt. r_g(1)) then - nig = NINT(ALOG10(rg(k))) + nig = NINT(LOG10(rg(k))) do nn = nig-1, nig+1 n = nn if ( (rg(k)/10.**nn).ge.1.0 .and. & @@ -2731,7 +2731,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & stoke_g = mvd_c(k)*mvd_c(k)*vtg*rho_w/(9.*visco(k)*xDg) if (xDg.gt. D0g) then if (stoke_g.ge.0.4 .and. stoke_g.le.10.) then - Ef_gw = 0.55*ALOG10(2.51*stoke_g) + Ef_gw = 0.55*LOG10(2.51*stoke_g) elseif (stoke_g.lt.0.4) then Ef_gw = 0.0 elseif (stoke_g.gt.10) then @@ -2748,22 +2748,22 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Snow and graupel collecting aerosols, wet scavenging. if (rs(k) .gt. r_s(1)) then - Ef_sa = Eff_aero(xDs,0.04E-6,visco(k),rho(k),temp(k),'s') + Ef_sa = Eff_aero(xDs,0.04E-6_kind_phys,visco(k),rho(k),temp(k),'s') pna_sca(k) = rhof(k)*t1_qs_qc*Ef_sa*nwfa(k)*smoe(k) pna_sca(k) = MIN(DBLE(nwfa(k)*odts), pna_sca(k)) - Ef_sa = Eff_aero(xDs,0.8E-6,visco(k),rho(k),temp(k),'s') + Ef_sa = Eff_aero(xDs,0.8E-6_kind_phys,visco(k),rho(k),temp(k),'s') pnd_scd(k) = rhof(k)*t1_qs_qc*Ef_sa*nifa(k)*smoe(k) pnd_scd(k) = MIN(DBLE(nifa(k)*odts), pnd_scd(k)) endif if (rg(k) .gt. r_g(1)) then xDg = (bm_g + mu_g + 1.) * ilamg(k) - Ef_ga = Eff_aero(xDg,0.04E-6,visco(k),rho(k),temp(k),'g') + Ef_ga = Eff_aero(xDg,0.04E-6_kind_phys,visco(k),rho(k),temp(k),'g') pna_gca(k) = rhof(k)*t1_qg_qc*Ef_ga*nwfa(k)*N0_g(k) & *ilamg(k)**cge(9) pna_gca(k) = MIN(DBLE(nwfa(k)*odts), pna_gca(k)) - Ef_ga = Eff_aero(xDg,0.8E-6,visco(k),rho(k),temp(k),'g') + Ef_ga = Eff_aero(xDg,0.8E-6_kind_phys,visco(k),rho(k),temp(k),'g') pnd_gcd(k) = rhof(k)*t1_qg_qc*Ef_ga*nifa(k)*N0_g(k) & *ilamg(k)**cge(9) pnd_gcd(k) = MIN(DBLE(nifa(k)*odts), pnd_gcd(k)) @@ -2900,7 +2900,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Ice nuclei lookup table index. if (xni.gt. Nt_IN(1)) then - niin = NINT(ALOG10(xni)) + niin = NINT(LOG10(xni)) do nn = niin-1, niin+1 n = nn if ( (xni/10.**nn).ge.1.0 .and. & @@ -3536,7 +3536,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) + ygra1 = log10(max(1.E-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) @@ -3624,7 +3624,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Cloud water lookup table index. if (rc(k).gt. r_c(1)) then - nic = NINT(ALOG10(rc(k))) + nic = NINT(LOG10(rc(k))) do nn = nic-1, nic+1 n = nn if ( (rc(k)/10.**nn).ge.1.0 .and. & @@ -4173,7 +4173,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & do k = kte, kts, -1 vtg = 0. if (rg(k).gt. R1) then - ygra1 = alog10(max(1.E-9, rg(k))) + ygra1 = log10(max(1.E-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) @@ -4838,7 +4838,7 @@ subroutine freezeH2O(threads) prob, vol, Texp, orho_w, & lam_exp, lamr, N0_r, lamc, N0_c, y INTEGER:: nu_c - REAL:: T_adjust + REAL(kind_phys):: T_adjust LOGICAL force_read_thompson, write_thompson_tables LOGICAL lexist,lopen INTEGER good,ierr @@ -4909,7 +4909,7 @@ subroutine freezeH2O(threads) !..Freeze water (smallest drops become cloud ice, otherwise graupel). do m = 1, ntb_IN - T_adjust = MAX(-3.0, MIN(3.0 - ALOG10(Nt_IN(m)), 3.0)) + T_adjust = MAX(-3.0, MIN(3.0 - LOG10(Nt_IN(m)), 3.0)) do k = 1, 45 ! print*, ' Freezing water for temp = ', -k Texp = DEXP( DFLOAT(k) - T_adjust*1.0D0 ) - 1.0D0 @@ -5009,7 +5009,7 @@ subroutine qi_aut_qs INTEGER:: i, j, n2 DOUBLE PRECISION, DIMENSION(nbi):: N_i DOUBLE PRECISION:: N0_i, lami, Di_mean, t1, t2 - REAL:: xlimit_intg + REAL(kind_phys):: xlimit_intg !+---+ @@ -5157,14 +5157,14 @@ end subroutine table_Efsw !! Function to compute collision efficiency of collector species (rain, !! snow, graupel) of aerosols. Follows Wang et al, 2010, ACP, which !! follows Slinn (1983). - real function Eff_aero(D, Da, visc,rhoa,Temp,species) + real(kind_phys) function Eff_aero(D, Da, visc,rhoa,Temp,species) implicit none - real:: D, Da, visc, rhoa, Temp + real(kind_phys):: D, Da, visc, rhoa, Temp character(LEN=1):: species - real:: aval, Cc, diff, Re, Sc, St, St2, vt, Eff - real, parameter:: boltzman = 1.3806503E-23 - real, parameter:: meanPath = 0.0256E-6 + real(kind_phys):: aval, Cc, diff, Re, Sc, St, St2, vt, Eff + real(kind_phys), parameter:: boltzman = 1.3806503E-23 + real(kind_phys), parameter:: meanPath = 0.0256E-6 vt = 1. if (species .eq. 'r') then @@ -5212,7 +5212,7 @@ subroutine table_dropEvap DOUBLE PRECISION:: summ, summ2, lamc, N0_c INTEGER:: nu_c ! DOUBLE PRECISION:: Nt_r, N0, lam_exp, lam -! REAL:: xlimit_intg +! REAL(kind_phys):: xlimit_intg do n = 1, nbc massc(n) = am_r*Dc(n)**bm_r @@ -5264,7 +5264,7 @@ subroutine table_dropEvap ! / DLOG(Dr(nbr)/D0r)) ! idx_d = MAX(1, MIN(idx_d, nbr)) ! -! nir = NINT(ALOG10(rr(k))) +! nir = NINT(LOG10(rr(k))) ! do nn = nir-1, nir+1 ! n = nn ! if ( (rr(k)/10.**nn).ge.1.0 .and. & @@ -5356,13 +5356,13 @@ end subroutine table_ccnAct ! TO_DO ITEM: For radiation cooling producing fog, in which case the !.. updraft velocity could easily be negative, we could use the temp !.. and its tendency to diagnose a pretend postive updraft velocity. - real function activ_ncloud(Tt, Ww, NCCN) + real(kind_phys) function activ_ncloud(Tt, Ww, NCCN) implicit none - REAL, INTENT(IN):: Tt, Ww, NCCN - REAL:: n_local, w_local + REAL(kind_phys), INTENT(IN):: Tt, Ww, NCCN + REAL(kind_phys):: n_local, w_local INTEGER:: i, j, k, l, m, n - REAL:: A, B, C, D, t, u, x1, x2, y1, y2, nx, wy, fraction + REAL(kind_phys):: A, B, C, D, t, u, x1, x2, y1, y2, nx, wy, fraction ! ta_Na = (/10.0, 31.6, 100.0, 316.0, 1000.0, 3160.0, 10000.0/) ntb_arc @@ -5446,12 +5446,12 @@ SUBROUTINE GCF(GAMMCF,A,X,GLN) ! --- USES GAMMLN IMPLICIT NONE INTEGER, PARAMETER:: ITMAX=100 - REAL, PARAMETER:: gEPS=3.E-7 - REAL, PARAMETER:: FPMIN=1.E-30 - REAL, INTENT(IN):: A, X - REAL:: GAMMCF,GLN + REAL(kind_phys), PARAMETER:: gEPS=3.E-7 + REAL(kind_phys), PARAMETER:: FPMIN=1.E-30 + REAL(kind_phys), INTENT(IN):: A, X + REAL(kind_phys):: GAMMCF,GLN INTEGER:: I - REAL:: AN,B,C,D,DEL,H + REAL(kind_phys):: AN,B,C,D,DEL,H GLN=GAMMLN(A) B=X+1.-A C=1./FPMIN @@ -5484,11 +5484,11 @@ SUBROUTINE GSER(GAMSER,A,X,GLN) ! --- USES GAMMLN IMPLICIT NONE INTEGER, PARAMETER:: ITMAX=100 - REAL, PARAMETER:: gEPS=3.E-7 - REAL, INTENT(IN):: A, X - REAL:: GAMSER,GLN + REAL(kind_phys), PARAMETER:: gEPS=3.E-7 + REAL(kind_phys), INTENT(IN):: A, X + REAL(kind_phys):: GAMSER,GLN INTEGER:: N - REAL:: AP,DEL,SUM + REAL(kind_phys):: AP,DEL,SUM GLN=GAMMLN(A) IF(X.LE.0.)THEN IF(X.LT.0.) PRINT *, 'X < 0 IN GSER' @@ -5511,10 +5511,10 @@ END SUBROUTINE GSER !>\ingroup aathompson !! Returns the value ln(gamma(xx)) for xx > 0. - REAL FUNCTION GAMMLN(XX) + REAL(kind_phys) FUNCTION GAMMLN(XX) ! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0. IMPLICIT NONE - REAL, INTENT(IN):: XX + REAL(kind_phys), INTENT(IN):: XX DOUBLE PRECISION, PARAMETER:: STP = 2.5066282746310005D0 DOUBLE PRECISION, DIMENSION(6), PARAMETER:: & COF = (/76.18009172947146D0, -86.50532032941677D0, & @@ -5537,13 +5537,13 @@ END FUNCTION GAMMLN ! (C) Copr. 1986-92 Numerical Recipes Software 2.02 !>\ingroup aathompson - REAL FUNCTION GAMMP(A,X) + REAL(kind_phys) FUNCTION GAMMP(A,X) ! --- COMPUTES THE INCOMPLETE GAMMA FUNCTION P(A,X) ! --- SEE ABRAMOWITZ AND STEGUN 6.5.1 ! --- USES GCF,GSER IMPLICIT NONE - REAL, INTENT(IN):: A,X - REAL:: GAMMCF,GAMSER,GLN + REAL(kind_phys), INTENT(IN):: A,X + REAL(kind_phys):: GAMMCF,GAMSER,GLN GAMMP = 0. IF((X.LT.0.) .OR. (A.LE.0.)) THEN PRINT *, 'BAD ARGUMENTS IN GAMMP' @@ -5559,10 +5559,10 @@ END FUNCTION GAMMP ! (C) Copr. 1986-92 Numerical Recipes Software 2.02 !+---+-----------------------------------------------------------------+ !>\ingroup aathompson - REAL FUNCTION WGAMMA(y) + REAL(kind_phys) FUNCTION WGAMMA(y) IMPLICIT NONE - REAL, INTENT(IN):: y + REAL(kind_phys), INTENT(IN):: y WGAMMA = EXP(GAMMLN(y)) @@ -5571,20 +5571,20 @@ END FUNCTION WGAMMA !>\ingroup aathompson !! THIS FUNCTION CALCULATES THE LIQUID SATURATION VAPOR MIXING RATIO AS !! A FUNCTION OF TEMPERATURE AND PRESSURE - REAL FUNCTION RSLF(P,T) + REAL(kind_phys) FUNCTION RSLF(P,T) IMPLICIT NONE - REAL, INTENT(IN):: P, T - REAL:: ESL,X - REAL, PARAMETER:: C0= .611583699E03 - REAL, PARAMETER:: C1= .444606896E02 - REAL, PARAMETER:: C2= .143177157E01 - REAL, PARAMETER:: C3= .264224321E-1 - REAL, PARAMETER:: C4= .299291081E-3 - REAL, PARAMETER:: C5= .203154182E-5 - REAL, PARAMETER:: C6= .702620698E-8 - REAL, PARAMETER:: C7= .379534310E-11 - REAL, PARAMETER:: C8=-.321582393E-13 + REAL(kind_phys), INTENT(IN):: P, T + REAL(kind_phys):: ESL,X + REAL(kind_phys), PARAMETER:: C0= .611583699E03 + REAL(kind_phys), PARAMETER:: C1= .444606896E02 + REAL(kind_phys), PARAMETER:: C2= .143177157E01 + REAL(kind_phys), PARAMETER:: C3= .264224321E-1 + REAL(kind_phys), PARAMETER:: C4= .299291081E-3 + REAL(kind_phys), PARAMETER:: C5= .203154182E-5 + REAL(kind_phys), PARAMETER:: C6= .702620698E-8 + REAL(kind_phys), PARAMETER:: C7= .379534310E-11 + REAL(kind_phys), PARAMETER:: C8=-.321582393E-13 X=MAX(-80.,T-273.16) @@ -5597,29 +5597,29 @@ REAL FUNCTION RSLF(P,T) ! ; Source: Murphy and Koop, Review of the vapour pressure of ice and ! supercooled water for atmospheric applications, Q. J. R. ! Meteorol. Soc (2005), 131, pp. 1539-1565. -! ESL = EXP(54.842763 - 6763.22 / T - 4.210 * ALOG(T) + 0.000367 * T +! ESL = EXP(54.842763 - 6763.22 / T - 4.210 * LOG(T) + 0.000367 * T ! + TANH(0.0415 * (T - 218.8)) * (53.878 - 1331.22 -! / T - 9.44523 * ALOG(T) + 0.014025 * T)) +! / T - 9.44523 * LOG(T) + 0.014025 * T)) END FUNCTION RSLF !+---+-----------------------------------------------------------------+ !>\ingroup aathompson !! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR MIXING RATIO AS A !! FUNCTION OF TEMPERATURE AND PRESSURE - REAL FUNCTION RSIF(P,T) + REAL(kind_phys) FUNCTION RSIF(P,T) IMPLICIT NONE - REAL, INTENT(IN):: P, T - REAL:: ESI,X - REAL, PARAMETER:: C0= .609868993E03 - REAL, PARAMETER:: C1= .499320233E02 - REAL, PARAMETER:: C2= .184672631E01 - REAL, PARAMETER:: C3= .402737184E-1 - REAL, PARAMETER:: C4= .565392987E-3 - REAL, PARAMETER:: C5= .521693933E-5 - REAL, PARAMETER:: C6= .307839583E-7 - REAL, PARAMETER:: C7= .105785160E-9 - REAL, PARAMETER:: C8= .161444444E-12 + REAL(kind_phys), INTENT(IN):: P, T + REAL(kind_phys):: ESI,X + REAL(kind_phys), PARAMETER:: C0= .609868993E03 + REAL(kind_phys), PARAMETER:: C1= .499320233E02 + REAL(kind_phys), PARAMETER:: C2= .184672631E01 + REAL(kind_phys), PARAMETER:: C3= .402737184E-1 + REAL(kind_phys), PARAMETER:: C4= .565392987E-3 + REAL(kind_phys), PARAMETER:: C5= .521693933E-5 + REAL(kind_phys), PARAMETER:: C6= .307839583E-7 + REAL(kind_phys), PARAMETER:: C7= .105785160E-9 + REAL(kind_phys), PARAMETER:: C8= .161444444E-12 X=MAX(-80.,T-273.16) ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8))))))) @@ -5630,35 +5630,35 @@ REAL FUNCTION RSIF(P,T) ! ; Source: Murphy and Koop, Review of the vapour pressure of ice and ! supercooled water for atmospheric applications, Q. J. R. ! Meteorol. Soc (2005), 131, pp. 1539-1565. -! ESI = EXP(9.550426 - 5723.265/T + 3.53068*ALOG(T) - 0.00728332*T) +! ESI = EXP(9.550426 - 5723.265/T + 3.53068*LOG(T) - 0.00728332*T) END FUNCTION RSIF !+---+-----------------------------------------------------------------+ !>\ingroup aathompson - real function iceDeMott(tempc, qv, qvs, qvsi, rho, nifa) + real(kind_phys) function iceDeMott(tempc, qv, qvs, qvsi, rho, nifa) implicit none - REAL, INTENT(IN):: tempc, qv, qvs, qvsi, rho, nifa + REAL(kind_phys), INTENT(IN):: tempc, qv, qvs, qvsi, rho, nifa !..Local vars - REAL:: satw, sati, siw, p_x, si0x, dtt, dsi, dsw, dab, fc, hx - REAL:: ntilde, n_in, nmax, nhat, mux, xni, nifa_cc - REAL, PARAMETER:: p_c1 = 1000. - REAL, PARAMETER:: p_rho_c = 0.76 - REAL, PARAMETER:: p_alpha = 1.0 - REAL, PARAMETER:: p_gam = 2. - REAL, PARAMETER:: delT = 5. - REAL, PARAMETER:: T0x = -40. - REAL, PARAMETER:: Sw0x = 0.97 - REAL, PARAMETER:: delSi = 0.1 - REAL, PARAMETER:: hdm = 0.15 - REAL, PARAMETER:: p_psi = 0.058707*p_gam/p_rho_c - REAL, PARAMETER:: aap = 1. - REAL, PARAMETER:: bbp = 0. - REAL, PARAMETER:: y1p = -35. - REAL, PARAMETER:: y2p = -25. - REAL, PARAMETER:: rho_not0 = 101325./(287.05*273.15) + REAL(kind_phys):: satw, sati, siw, p_x, si0x, dtt, dsi, dsw, dab, fc, hx + REAL(kind_phys):: ntilde, n_in, nmax, nhat, mux, xni, nifa_cc + REAL(kind_phys), PARAMETER:: p_c1 = 1000. + REAL(kind_phys), PARAMETER:: p_rho_c = 0.76 + REAL(kind_phys), PARAMETER:: p_alpha = 1.0 + REAL(kind_phys), PARAMETER:: p_gam = 2. + REAL(kind_phys), PARAMETER:: delT = 5. + REAL(kind_phys), PARAMETER:: T0x = -40. + REAL(kind_phys), PARAMETER:: Sw0x = 0.97 + REAL(kind_phys), PARAMETER:: delSi = 0.1 + REAL(kind_phys), PARAMETER:: hdm = 0.15 + REAL(kind_phys), PARAMETER:: p_psi = 0.058707*p_gam/p_rho_c + REAL(kind_phys), PARAMETER:: aap = 1. + REAL(kind_phys), PARAMETER:: bbp = 0. + REAL(kind_phys), PARAMETER:: y1p = -35. + REAL(kind_phys), PARAMETER:: y2p = -25. + REAL(kind_phys), PARAMETER:: rho_not0 = 101325./(287.05*273.15) !+---+ @@ -5710,17 +5710,17 @@ end FUNCTION iceDeMott !! Newer research since Koop et al (2001) suggests that the freezing !! rate should be lower than original paper, so J_rate is reduced !! by two orders of magnitude. - real function iceKoop(temp, qv, qvs, naero, dt) + real(kind_phys) function iceKoop(temp, qv, qvs, naero, dt) implicit none - REAL, INTENT(IN):: temp, qv, qvs, naero, DT - REAL:: mu_diff, a_w_i, delta_aw, log_J_rate, J_rate, prob_h, satw - REAL:: xni + REAL(kind_phys), INTENT(IN):: temp, qv, qvs, naero, DT + REAL(kind_phys):: mu_diff, a_w_i, delta_aw, log_J_rate, J_rate, prob_h, satw + REAL(kind_phys):: xni xni = 0.0 satw = qv/qvs mu_diff = 210368.0 + (131.438*temp) - (3.32373E6/temp) & - & - (41729.1*alog(temp)) + & - (41729.1*log(temp)) a_w_i = exp(mu_diff/(R_uni*temp)) delta_aw = satw - a_w_i log_J_rate = -906.7 + (8502.0*delta_aw) & @@ -5740,11 +5740,11 @@ end FUNCTION iceKoop !+---+-----------------------------------------------------------------+ !>\ingroup aathompson !! Helper routine for Phillips et al (2008) ice nucleation. - REAL FUNCTION delta_p (yy, y1, y2, aa, bb) + REAL(kind_phys) FUNCTION delta_p (yy, y1, y2, aa, bb) IMPLICIT NONE - REAL, INTENT(IN):: yy, y1, y2, aa, bb - REAL:: dab, A, B, a0, a1, a2, a3 + REAL(kind_phys), INTENT(IN):: yy, y1, y2, aa, bb + REAL(kind_phys):: dab, A, B, a0, a1, a2, a3 A = 6.*(aa-bb)/((y2-y1)*(y2-y1)*(y2-y1)) B = aa+(A*y1*y1*y1/6.)-(A*y1*y1*y2*0.5) @@ -5790,19 +5790,19 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & !..Sub arguments INTEGER, INTENT(IN):: kts, kte - REAL, DIMENSION(kts:kte), INTENT(IN):: & + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: & & t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d - REAL, DIMENSION(kts:kte), INTENT(OUT):: re_qc1d, re_qi1d, re_qs1d + REAL(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: re_qc1d, re_qi1d, re_qs1d !..Local variables INTEGER:: k - REAL, DIMENSION(kts:kte):: rho, rc, nc, ri, ni, rs - REAL:: smo2, smob, smoc - REAL:: tc0, loga_, a_, b_ + REAL(kind_phys), DIMENSION(kts:kte):: rho, rc, nc, ri, ni, rs + REAL(kind_phys):: smo2, smob, smoc + REAL(kind_phys):: tc0, loga_, a_, b_ DOUBLE PRECISION:: lamc, lami LOGICAL:: has_qc, has_qi, has_qs INTEGER:: inu_c INTEGER:: lsml - real, dimension(15), parameter:: g_ratio = (/24,60,120,210,336, & + real(kind_phys), dimension(15), parameter:: g_ratio = (/24,60,120,210,336, & & 504,720,990,1320,1716,2184,2730,3360,4080,4896/) has_qc = .false. @@ -5914,31 +5914,31 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !..Sub arguments INTEGER, INTENT(IN):: kts, kte, ii, jj - REAL, INTENT(IN):: rand1 - REAL, DIMENSION(kts:kte), INTENT(IN):: & + REAL(kind_phys), INTENT(IN):: rand1 + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: & qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ - REAL, DIMENSION(kts:kte), OPTIONAL, INTENT(INOUT):: vt_dBZ + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: dBZ + REAL(kind_phys), DIMENSION(kts:kte), OPTIONAL, INTENT(INOUT):: vt_dBZ LOGICAL, OPTIONAL, INTENT(IN) :: first_time_step !..Local variables LOGICAL :: do_vt_dBZ LOGICAL :: allow_wet_graupel LOGICAL :: allow_wet_snow - REAL, DIMENSION(kts:kte):: temp, pres, qv, rho, rhof - REAL, DIMENSION(kts:kte):: rc, rr, nr, rs, rg + REAL(kind_phys), DIMENSION(kts:kte):: temp, pres, qv, rho, rhof + REAL(kind_phys), DIMENSION(kts:kte):: rc, rr, nr, rs, rg DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilamg, N0_r, N0_g - REAL, DIMENSION(kts:kte):: mvd_r - REAL, DIMENSION(kts:kte):: smob, smo2, smoc, smoz - REAL:: oM3, M0, Mrat, slam1, slam2, xDs - REAL:: ils1, ils2, t1_vts, t2_vts, t3_vts, t4_vts - REAL:: vtr_dbz_wt, vts_dbz_wt, vtg_dbz_wt + REAL(kind_phys), DIMENSION(kts:kte):: mvd_r + REAL(kind_phys), DIMENSION(kts:kte):: smob, smo2, smoc, smoz + REAL(kind_phys):: oM3, M0, Mrat, slam1, slam2, xDs + REAL(kind_phys):: ils1, ils2, t1_vts, t2_vts, t3_vts, t4_vts + REAL(kind_phys):: vtr_dbz_wt, vts_dbz_wt, vtg_dbz_wt - REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel + REAL(kind_phys), DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel DOUBLE PRECISION:: N0_exp, N0_min, lam_exp, lamr, lamg - REAL:: a_, b_, loga_, tc0, SR + REAL(kind_phys):: a_, b_, loga_, tc0, SR DOUBLE PRECISION:: fmelt_s, fmelt_g INTEGER:: i, k, k_0, kbot, n @@ -5946,7 +5946,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg DOUBLE PRECISION:: cback, x, eta, f_d - REAL:: xslw1, ygra1, zans1 + REAL(kind_phys):: xslw1, ygra1, zans1 !+---+ if (present(vt_dBZ) .and. present(first_time_step)) then @@ -6076,7 +6076,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & if (ANY(L_qg .eqv. .true.)) then do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) + ygra1 = log10(max(1.E-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) @@ -6251,21 +6251,21 @@ SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,pfsan,dt,R1) implicit none integer, intent(in) :: km - real, intent(in) :: dt, R1 - real, intent(in) :: dzl(km),wwl(km) - real, intent(out) :: precip - real, intent(inout) :: rql(km) - real, intent(out) :: pfsan(km) + real(kind_phys), intent(in) :: dt, R1 + real(kind_phys), intent(in) :: dzl(km),wwl(km) + real(kind_phys), intent(out) :: precip + real(kind_phys), intent(inout) :: rql(km) + real(kind_phys), intent(out) :: pfsan(km) integer k,m,kk,kb,kt - real tl,tl2,qql,dql,qqd - real th,th2,qqh,dqh - real zsum,qsum,dim,dip,con1,fa1,fa2 - real allold, decfl - real dz(km), ww(km), qq(km) - real wi(km+1), zi(km+1), za(km+2) - real qn(km) - real dza(km+1), qa(km+1), qmi(km+1), qpi(km+1) - real net_flx(km) + real(kind_phys) tl,tl2,qql,dql,qqd + real(kind_phys) th,th2,qqh,dqh + real(kind_phys) zsum,qsum,dim,dip,con1,fa1,fa2 + real(kind_phys) allold, decfl + real(kind_phys) dz(km), ww(km), qq(km) + real(kind_phys) wi(km+1), zi(km+1), za(km+2) + real(kind_phys) qn(km) + real(kind_phys) dza(km+1), qa(km+1), qmi(km+1), qpi(km+1) + real(kind_phys) net_flx(km) ! precip = 0.0 qa(:) = 0.0 diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index 72a1055dd..3aa99284d 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -4,6 +4,7 @@ !>\ingroup aathompson module module_mp_thompson_make_number_concentrations + use machine, only: kind_phys use physcons, only: PI => con_pi implicit none @@ -30,14 +31,12 @@ module module_mp_thompson_make_number_concentrations !! as a function of Temperature from -94C to 0C. Taken from WRF RRTMG !! radiation code where it is attributed to Jon Egill Kristjansson !! and coauthors. - elemental real function make_IceNumber (Q_ice, temp) + elemental real(kind_phys) function make_IceNumber (Q_ice, temp) - !IMPLICIT NONE - REAL, PARAMETER:: Ice_density = 890.0 - !REAL, PARAMETER:: PI = 3.1415926536 - real, intent(in):: Q_ice, temp + real(kind_phys), parameter:: Ice_density = 890.0 + real(kind_phys), intent(in):: Q_ice, temp integer idx_rei - real corr, reice, deice + real(kind_phys) corr, reice, deice double precision lambda !+---+-----------------------------------------------------------------+ @@ -65,7 +64,7 @@ elemental real function make_IceNumber (Q_ice, temp) ! 124.954, 130.630, 136.457, 142.446, 148.608, 154.956, & ! 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & ! 205.728, 214.055, 222.694, 231.661, 240.971, 250.639/ - real, dimension(95), parameter:: retab = (/ & + real(kind_phys), dimension(95), parameter:: retab = (/ & 5.92779, 6.26422, 6.61973, 6.99539, 7.39234, & 7.81177, 8.25496, 8.72323, 9.21800, 9.74075, 10.2930, & 10.8765, 11.4929, 12.1440, 12.8317, 13.5581, 14.2319, & @@ -130,18 +129,15 @@ end function make_IceNumber !>\ingroup aathompson !! - elemental real function make_DropletNumber (Q_cloud, qnwfa) + elemental real(kind_phys) function make_DropletNumber (Q_cloud, qnwfa) - !IMPLICIT NONE + real(kind_phys), intent(in):: Q_cloud, qnwfa - real, intent(in):: Q_cloud, qnwfa - - !real, parameter:: PI = 3.1415926536 - real, parameter:: am_r = PI*1000./6. - real, dimension(15), parameter:: g_ratio = (/24,60,120,210,336, & + real(kind_phys), parameter:: am_r = PI*1000./6. + real(kind_phys), dimension(15), parameter:: g_ratio = (/24,60,120,210,336, & & 504,720,990,1320,1716,2184,2730,3360,4080,4896/) double precision:: lambda, qnc - real:: q_nwfa, x1, xDc + real(kind_phys):: q_nwfa, x1, xDc integer:: nu_c if (Q_cloud == 0) then @@ -169,14 +165,11 @@ end function make_DropletNumber !>\ingroup aathompson !! - elemental real function make_RainNumber (Q_rain, temp) - - IMPLICIT NONE + elemental real(kind_phys) function make_RainNumber (Q_rain, temp) - real, intent(in):: Q_rain, temp + real(kind_phys), intent(in):: Q_rain, temp double precision:: lambda, N0, qnr - !real, parameter:: PI = 3.1415926536 - real, parameter:: am_r = PI*1000./6. + real(kind_phys), parameter:: am_r = PI*1000./6. if (Q_rain == 0) then make_RainNumber = 0 diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index 980035fe6..c01b7c07b 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -753,7 +753,7 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) ! ze = a2*d_sfs ! not used! - l = int_epn(0.0,d_sfs,0.0,d_sfs,2) + l = int_epn(0.0_kind_phys,d_sfs,0.0_kind_phys,d_sfs,2) ! t_sfs = xt/l ! xz = (xt+xt) / t_sfs diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 6a183da52..8f0f91cc3 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -138,9 +138,9 @@ elemental subroutine sw_ps_9b(z,fxp) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: fxp - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + real(kind_phys),intent(in):: z + real(kind_phys),intent(out):: fxp + real(kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then @@ -171,9 +171,9 @@ elemental subroutine sw_ps_9b_aw(z,aw) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: aw - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + real(kind_phys),intent(in):: z + real(kind_phys),intent(out):: aw + real(kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then @@ -514,8 +514,8 @@ subroutine solar_time_from_julian(jday,xlon,soltim) ! fjd=jday-floor(jday) fjd=jday - xhr=floor(fjd*24.0)-sign(12.0,fjd-0.5) - xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-0.5))*60 + xhr=floor(fjd*24.0)-sign(12.0_kind_phys,fjd-0.5) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0_kind_phys,fjd-0.5))*60 xsec=0 intime=xhr+xmin/60.0+xsec/3600.0+24.0 soltim=mod(xlon/15.0+intime,24.0)*3600.0 diff --git a/physics/module_sf_noahmplsm.F90 b/physics/module_sf_noahmplsm.F90 index 7807ee475..16756762a 100644 --- a/physics/module_sf_noahmplsm.F90 +++ b/physics/module_sf_noahmplsm.F90 @@ -3190,13 +3190,13 @@ subroutine snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) dela0 = dt/parameters%tau0 arg = parameters%grain_growth*(1./tfrz-1./tg) age1 = exp(arg) - age2 = exp(amin1(0.,parameters%extra_growth*arg)) + age2 = exp(min(0.,parameters%extra_growth*arg)) age3 = parameters%dirt_soot tage = age1+age2+age3 dela = dela0*tage - dels = amax1(0.0,sneqv-sneqvo) / parameters%swemx + dels = max(0.0,sneqv-sneqvo) / parameters%swemx sge = (tauss+dela)*(1.0-dels) - tauss = amax1(0.,sge) + tauss = max(0.,sge) endif fage= tauss/(tauss+1.) @@ -3250,7 +3250,7 @@ subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) sl1=1./sl sl2=2.*sl cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) - fzen=amax1(cf1,0.) + fzen=max(cf1,0.) albsni(1)=parameters%bats_vis_new*(1.-parameters%bats_vis_age*fage) albsni(2)=parameters%bats_nir_new*(1.-parameters%bats_nir_age*fage) @@ -3559,7 +3559,7 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! tmp1 = b*b - c*c h = sqrt(tmp1) / avmu sigma = tmp0*tmp0 - tmp1 - if ( abs (sigma) < 1.e-6 ) sigma = sign(1.e-6,sigma) + if ( abs (sigma) < 1.e-6 ) sigma = sign(1.e-6_kind_phys,sigma) p1 = b + avmu*h p2 = b - avmu*h p3 = b + tmp0 @@ -4593,7 +4593,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & ! z0h = z0m !* exp(-czil*0.4*258.2*sqrt(fv*z0m)) ! end if call thermalz0(parameters,fveg,z0m,z0m,zlvl,zpd,zpd,ustarx, & !in - vegtyp,0.,ur,csigmaf0,csigmaf1,temptrs,temptrs,temptrs,0, & !in + vegtyp,0.0_kind_phys,ur,csigmaf0,csigmaf1,temptrs,temptrs,temptrs,0, & !in z0mo,z0h) if(opt_sfc == 1) then @@ -10005,7 +10005,7 @@ end subroutine psn_crop ! ! transform vegfrac to lai ! -! elai = max(0.0,-6.5/2.5*alog((1.-vegfrac))) +! elai = max(0.0,-6.5/2.5*log((1.-vegfrac))) ! density = elai / (parameters%slarea(vegtyp) * 0.5) ! ! calculate the voc flux @@ -10370,13 +10370,13 @@ subroutine sfcdif4(iloc ,jloc ,ux ,vx ,t1d , & if ( present(iz0tlnd) ) then if ( iz0tlnd .le. 1 ) then call zilitinkevich_1995(znt,zt,zq,restar,& - ust,vkc,1.0,iz0tlnd,0,0.0) + ust,vkc,1.0_kind_phys,iz0tlnd,0,0.0_kind_phys) elseif ( iz0tlnd .eq. 2 ) then call yang_2008(znt,zt,zq,ust,molx,& qstar,restar,visc) elseif ( iz0tlnd .eq. 3 ) then !original mynn in wrf-arw used this form: - call garratt_1992(zt,zq,znt,restar,1.0) + call garratt_1992(zt,zq,znt,restar,1.0_kind_phys) endif ! the GFS option is removed along with gfs_z0_lnd @@ -10385,7 +10385,7 @@ subroutine sfcdif4(iloc ,jloc ,ux ,vx ,t1d , & !default to zilitinkevich call zilitinkevich_1995(znt,zt,zq,restar,& - ust,vkc,1.0,0,0,0.0) + ust,vkc,1.0_kind_phys,0,0,0.0_kind_phys) endif endif @@ -11119,8 +11119,8 @@ real*8 function psim_unstable_full(zolf) real (kind=kind_phys) :: zolf,x,ym,psimc,psimk x=(1.-16.*zolf)**.25 - !psimk=2*alog(0.5*(1+x))+alog(0.5*(1+x*x))-2.*atan(x)+2.*atan(1.) - psimk=2.*alog(0.5*(1+x))+alog(0.5*(1+x*x))-2.*atan(x)+2.*atan1 + !psimk=2*log(0.5*(1+x))+log(0.5*(1+x*x))-2.*atan(x)+2.*atan(1.) + psimk=2.*log(0.5*(1+x))+log(0.5*(1+x*x))-2.*atan(x)+2.*atan1 ym=(1.-10.*zolf)**onethird !psimc=(3./2.)*log((ym**2.+ym+1.)/3.)-sqrt(3.)*atan((2.*ym+1)/sqrt(3.))+4.*atan(1.)/sqrt(3.) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index e62e8a596..556296b48 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -200,7 +200,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & else h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) endif - niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 + niCCN3 = -1.0*LOG(naCCN1/naCCN0)/h_01 nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) z1 = hgt(i,2)-hgt(i,1) nwfa2d(i) = nwfa(i,1) * 0.000196 * (50./z1) @@ -243,7 +243,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & else h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) endif - niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 + niIN3 = -1.0*LOG(naIN1/naIN0)/h_01 nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) nifa2d(i) = 0. do k = 2, nlev @@ -375,7 +375,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(in ) :: dtp logical, intent(in ) :: first_time_step integer, intent(in ) :: istep, nsteps - real, intent(in ) :: dt_inner + real(kind_phys), intent(in ) :: dt_inner ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip real(kind_phys), intent(inout) :: prcp(:) real(kind_phys), intent(inout) :: rain(:) diff --git a/physics/progsigma_calc.f90 b/physics/progsigma_calc.f90 index c87308602..073e557af 100644 --- a/physics/progsigma_calc.f90 +++ b/physics/progsigma_calc.f90 @@ -180,9 +180,9 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & if(cnvflg(i))then DEN=MIN(termC(i)+termB(i),1.E8) cvg=termD(i)*delt - ZZ=MAX(0.0,SIGN(1.0,termA(i))) & - *MAX(0.0,SIGN(1.0,termB(i))) & - *MAX(0.0,SIGN(1.0,termC(i)-epsilon)) + ZZ=MAX(0.0,SIGN(1.0_kind_phys,termA(i))) & + *MAX(0.0,SIGN(1.0_kind_phys,termB(i))) & + *MAX(0.0,SIGN(1.0_kind_phys,termC(i)-epsilon)) cvg=MAX(0.0,cvg) sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ)) if(sigmab(i)>0.)then diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 3029398e9..64353efc6 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -3295,17 +3295,18 @@ SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, dz, & ! INTEGER, INTENT(IN):: kts, kte LOGICAL, INTENT(IN):: modify_qvapor - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qv, qc, qi, cldfra - REAL, DIMENSION(kts:kte), INTENT(IN):: p, t, dz, qs - REAL, INTENT(IN):: gridkm, XLAND, max_relh + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qv, qc, qi + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: cldfra + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: p, t, dz, qs + REAL(kind_phys), INTENT(IN):: gridkm, XLAND, max_relh LOGICAL, INTENT(IN):: debug_flag !..Local vars. - REAL:: RH_00L, RH_00O, RH_00 - REAL:: entrmnt=0.5 + REAL(kind_phys):: RH_00L, RH_00O, RH_00 + REAL(kind_phys):: entrmnt=0.5 INTEGER:: k - REAL:: TC, qvsi, qvsw, RHUM, delz, var_temp - REAL, DIMENSION(kts:kte):: qvs, rh, rhoa + REAL(kind_phys):: TC, qvsi, qvsw, RHUM, delz, var_temp + REAL(kind_phys), DIMENSION(kts:kte):: qvs, rh, rhoa integer:: ndebug = 0 character*512 dbg_msg @@ -3437,13 +3438,16 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, Dz1d, entrmnt,& ! INTEGER, INTENT(IN):: kts, kte LOGICAL, INTENT(IN):: debugfl - REAL, INTENT(IN):: entrmnt - REAL, DIMENSION(kts:kte), INTENT(IN):: qs1d,qvs1d,T1d,P1d,Dz1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d, qc1d, qi1d + REAL(kind_phys), INTENT(IN):: entrmnt + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: qs1d,qvs1d + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: T1d,P1d,Dz1d + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: cfr1d + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qc1d + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qi1d !..Local vars. - REAL, DIMENSION(kts:kte):: theta - REAL:: theta1, theta2, delz + REAL(kind_phys), DIMENSION(kts:kte):: theta + REAL(kind_phys):: theta1, theta2, delz INTEGER:: k, k2, k_tropo, k_m12C, k_cldb, k_cldt, kbot, k_p200 LOGICAL:: in_cloud character*512 dbg_msg @@ -3593,10 +3597,14 @@ SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs,T,dz,entr, k1,k2,kts,kte) IMPLICIT NONE ! INTEGER, INTENT(IN):: k1,k2, kts,kte - REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qs, qvs, T, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi - REAL:: iwc, max_iwc, tdz, this_iwc, this_dz + REAL(kind_phys), INTENT(IN):: entr + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: cfr + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: qs + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: qvs + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: T + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: dz + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qi + REAL(kind_phys):: iwc, max_iwc, tdz, this_iwc, this_dz INTEGER:: k tdz = 0. @@ -3635,10 +3643,10 @@ SUBROUTINE adjust_cloudH2O(cfr, qc, qvs,T,dz,entr, k1,k2,kts,kte) IMPLICIT NONE ! INTEGER, INTENT(IN):: k1,k2, kts,kte - REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc - REAL:: lwc, max_lwc, tdz, this_lwc, this_dz + REAL(kind_phys), INTENT(IN):: entr + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, dz + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qc + REAL(kind_phys):: lwc, max_lwc, tdz, this_lwc, this_dz INTEGER:: k tdz = 0. @@ -3679,9 +3687,9 @@ SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte) IMPLICIT NONE ! INTEGER, INTENT(IN):: kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc, qi - REAL:: lwp, iwp, xfac + REAL(kind_phys), DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz + REAL(kind_phys), DIMENSION(kts:kte), INTENT(INOUT):: qc, qi + REAL(kind_phys):: lwp, iwp, xfac INTEGER:: k lwp = 0. diff --git a/physics/rrtmgp_lw_main.meta b/physics/rrtmgp_lw_main.meta index fd96eb14b..263cae680 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/rrtmgp_lw_main.meta @@ -7,6 +7,11 @@ dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90 + dependencies = rte-rrtmgp/rte/mo_rte_util_array.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 + dependencies = rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_main.meta b/physics/rrtmgp_sw_main.meta index dbb93a5df..89d8258c8 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/rrtmgp_sw_main.meta @@ -7,6 +7,11 @@ dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90 + dependencies = rte-rrtmgp/rte/mo_rte_util_array.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 + dependencies = rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/surface_perturbation.F90 b/physics/surface_perturbation.F90 index e0429a5fc..7ddbe5279 100644 --- a/physics/surface_perturbation.F90 +++ b/physics/surface_perturbation.F90 @@ -48,7 +48,7 @@ subroutine cdfnor(z,cdfz) cdfz = 0.5 else x = 0.5*z*z - call cdfgam(x,0.5,del,iflag, cdfx) + call cdfgam(x,0.5_kind_phys,del,iflag, cdfx) if (iflag.ne.0) return if (z.gt.0.0) then cdfz = 0.5+0.5*cdfx diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 0f4ad447e..2bdf2bdc0 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -961,98 +961,101 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles - real, intent(in) :: dtime ! model time step - real, intent(in) :: vm1(klon,klev) ! meridional wind - real, intent(in) :: um1(klon,klev) ! zonal wind - real, intent(in) :: qm1(klon,klev) ! spec. humidity - real, intent(in) :: tm1(klon,klev) ! kin temperature - - real, intent(in) :: prsl(klon,klev) ! mid-layer pressure - real, intent(in) :: philg(klon,klev) ! m2/s2-phil => meters !!!!! phil =philg/grav - real, intent(in) :: prsi(klon,klev+1)! prsi interface pressure - real, intent(in) :: xlatd(klon) ! lat was in radians, now with xlat_d in degrees - real, intent(in) :: sinlat(klon) - real, intent(in) :: coslat(klon) - real, intent(in) :: tau_ngw(klon) + real(kind_phys), intent(in) :: dtime ! model time step + real(kind_phys), intent(in) :: vm1(klon,klev) ! meridional wind + real(kind_phys), intent(in) :: um1(klon,klev) ! zonal wind + real(kind_phys), intent(in) :: qm1(klon,klev) ! spec. humidity + real(kind_phys), intent(in) :: tm1(klon,klev) ! kin temperature + + real(kind_phys), intent(in) :: prsl(klon,klev) ! mid-layer pressure + real(kind_phys), intent(in) :: philg(klon,klev) ! m2/s2-phil => meters !!!!! phil =philg/grav + real(kind_phys), intent(in) :: prsi(klon,klev+1)! prsi interface pressure + real(kind_phys), intent(in) :: xlatd(klon) ! lat was in radians, now with xlat_d in degrees + real(kind_phys), intent(in) :: sinlat(klon) + real(kind_phys), intent(in) :: coslat(klon) + real(kind_phys), intent(in) :: tau_ngw(klon) integer, intent(in) :: mpi_id, master, kdt ! ! ! out-gw effects ! - real, intent(out) :: pdudt(klon,klev) ! zonal momentum tendency - real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency - real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp - real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5_kp ! - real, parameter :: epsln = 1.0e-12_kp ! - real, parameter :: zero = 0.0_kp, one = 1.0_kp, half = 0.5_kp + real(kind_phys), intent(out) :: pdudt(klon,klev) ! zonal momentum tendency + real(kind_phys), intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency + real(kind_phys), intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp + real(kind_phys), intent(out) :: dked(klon,klev) ! gw-eddy diffusion + real(kind_phys), parameter :: minvel = 0.5_kind_phys + real(kind_phys), parameter :: epsln = 1.0e-12_kind_phys + real(kind_phys), parameter :: zero = 0.0_kind_phys + real(kind_phys), parameter :: one = 1.0_kind_phys + real(kind_phys), parameter :: half = 0.5_kind_phys !vay-2018 - real :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) - real :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) - real :: phil(klon,klev) ! gphil/grav + real(kind_phys) :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) + real(kind_phys) :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) + real(kind_phys) :: phil(klon,klev) ! gphil/grav ! ! local =============================================================================================== ! -! real :: zthm1(klon,klev) ! temperature interface levels - real :: zthm1 ! 1.0 / temperature interface levels - real :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency - real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency - real :: zrhohm1(klon,ilaunch:klev) ! interface density - real :: zuhm1(klon,ilaunch:klev) ! interface zonal wind - real :: zvhm1(klon,ilaunch:klev) ! meridional wind - real :: v_zmet(klon,ilaunch:klev) - real :: vueff(klon,ilaunch:klev) - real :: zbvfl(klon) ! BV at launch level - real :: c2f2(klon) +! real(kind_phys) :: zthm1(klon,klev) ! temperature interface levels + real(kind_phys) :: zthm1 ! 1.0 / temperature interface levels + real(kind_phys) :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency + real(kind_phys) :: zbn2(klon,ilaunch:klev) ! interface BV-frequency + real(kind_phys) :: zrhohm1(klon,ilaunch:klev) ! interface density + real(kind_phys) :: zuhm1(klon,ilaunch:klev) ! interface zonal wind + real(kind_phys) :: zvhm1(klon,ilaunch:klev) ! meridional wind + real(kind_phys) :: v_zmet(klon,ilaunch:klev) + real(kind_phys) :: vueff(klon,ilaunch:klev) + real(kind_phys) :: zbvfl(klon) ! BV at launch level + real(kind_phys) :: c2f2(klon) !23456 - real :: zul(klon,nazd) ! velocity in azimuthal direction at launch level - real :: zci_min(klon,nazd) -! real :: zcrt(klon,klev,nazd) ! not used - do we need it? Moorthi - real :: zact(klon, nwav, nazd) ! if =1 then critical level encountered => c-u -! real :: zacc(klon, nwav, nazd) ! not used! + real(kind_phys) :: zul(klon,nazd) ! velocity in azimuthal direction at launch level + real(kind_phys) :: zci_min(klon,nazd) +! real(kind_phys) :: zcrt(klon,klev,nazd) ! not used - do we need it? Moorthi + real(kind_phys) :: zact(klon, nwav, nazd) ! if =1 then critical level encountered => c-u +! real(kind_phys) :: zacc(klon, nwav, nazd) ! not used! ! - real :: zpu(klon,klev, nazd) ! momentum flux -! real :: zdfl(klon,klev, nazd) - real :: zfct(klon,klev) - real :: zfnorm(klon) ! normalisation factor + real(kind_phys) :: zpu(klon,klev, nazd) ! momentum flux +! real(kind_phys) :: zdfl(klon,klev, nazd) + real(kind_phys) :: zfct(klon,klev) + real(kind_phys) :: zfnorm(klon) ! normalisation factor - real :: zfluxlaun(klon) - real :: zui(klon, klev,nazd) + real(kind_phys) :: zfluxlaun(klon) + real(kind_phys) :: zui(klon, klev,nazd) ! - real :: zdfdz_v(klon,klev, nazd) ! axj = -df*rho/dz directional momentum depositiom - real :: zflux(klon, nwav, nazd) ! momentum flux at each level stored as ( ix, mode, iazdim) + real(kind_phys) :: zdfdz_v(klon,klev, nazd) ! axj = -df*rho/dz directional momentum depositiom + real(kind_phys) :: zflux(klon, nwav, nazd) ! momentum flux at each level stored as ( ix, mode, iazdim) - real :: zflux_z (klon, nwav,klev) !momentum flux at each azimuth stored as ( ix, mode, klev) + real(kind_phys) :: zflux_z (klon, nwav,klev) !momentum flux at each azimuth stored as ( ix, mode, klev) ! - real :: vm_zflx_mode, vc_zflx_mode - real :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2 + real(kind_phys) :: vm_zflx_mode, vc_zflx_mode + real(kind_phys) :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2 -! real :: zang, znorm, zang1, ztx - real :: zu, zcin, zcpeak, zcin4, zbvfl4 - real :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc - real :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft, ze1, ze2 +! real(kind_phys) :: zang, znorm, zang1, ztx + real(kind_phys) :: zu, zcin, zcpeak, zcin4, zbvfl4 + real(kind_phys) :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc + real(kind_phys) :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft + real(kind_phys) :: ze1, ze2 ! - real :: zdelp,zrgpts - real :: zthstd,zrhostd,zbvfstd - real :: tvc1, tvm1, tem1, tem2, tem3 - real :: zhook_handle - real :: delpi(klon,ilaunch:klev) + real(kind_phys) :: zdelp,zrgpts + real(kind_phys) :: zthstd,zrhostd,zbvfstd + real(kind_phys) :: tvc1, tvm1, tem1, tem2, tem3 + real(kind_phys) :: zhook_handle + real(kind_phys) :: delpi(klon,ilaunch:klev) -! real :: rcpd, grav2cpd - real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g +! real(kind_phys) :: rcpd, grav2cpd + real(kind_phys), parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp &, cpdi = one/cpd - real :: expdis, fdis -! real :: fmode, expdis, fdis - real :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 + real(kind_phys) :: expdis, fdis +! real(kind_phys) :: fmode, expdis, fdis + real(kind_phys) :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 integer :: j, k, inc, jk, jl, iazi !