From 06aeee65e2f084acba2340a1245f1722df26eaf4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Jan 2020 19:12:59 +0000 Subject: [PATCH] after updating the code based on climbfuji comments from CCPP --- physics/GFS_DCNV_generic.F90 | 12 +- physics/GFS_DCNV_generic.meta | 32 -- physics/GFS_MP_generic.F90 | 20 +- physics/GFS_MP_generic.meta | 32 -- physics/GFS_PBL_generic.F90 | 39 +- physics/GFS_PBL_generic.meta | 82 ---- physics/GFS_SCNV_generic.F90 | 6 +- physics/GFS_SCNV_generic.meta | 16 - physics/GFS_suite_interstitial.F90 | 59 +-- physics/GFS_suite_interstitial.meta | 40 -- physics/GFS_surface_composites.F90 | 4 - physics/gcm_shoc.F90 | 107 +---- physics/gcm_shoc.meta | 24 -- physics/m_micro.F90 | 24 +- physics/m_micro.meta | 33 +- physics/micro_mg2_0.F90 | 10 +- physics/micro_mg3_0.F90 | 8 +- physics/moninshoc.f | 26 +- physics/moninshoc.meta | 24 -- physics/rascnv.F90 | 643 +++------------------------- physics/rascnv.meta | 142 +++++- 21 files changed, 254 insertions(+), 1129 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 7bb56d361..d7305cbe5 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -20,14 +20,14 @@ end subroutine GFS_DCNV_generic_pre_finalize subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,& isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & - dqdti, lprnt, ipr, errmsg, errflg) + dqdti, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 @@ -107,14 +107,14 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & - cape, tconvtend, qconvtend, uconvtend, vconvtend, lprnt, ipr, errmsg, errflg) + cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 724db885e..07c75eafc 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -147,22 +147,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -579,22 +563,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 20b752b24..f72f9405a 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,13 +16,13 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \htmlinclude GFS_MP_generic_pre_run.html !! - subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, lprnt, ipr, errmsg, errflg) + subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ntcw, nncl, ntrac, ipr - logical, intent(in) :: ldiag3d, do_aw, lprnt + integer, intent(in) :: im, levs, ntcw, nncl, ntrac + logical, intent(in) :: ldiag3d, do_aw real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 @@ -86,15 +86,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, lprnt, ipr, errmsg, errflg) + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys implicit none - integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, ipr + integer, intent(in) :: im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm, lprnt + logical, intent(in) :: cal_pre, lssav, ldiag3d, cplflx, cplchm real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc @@ -217,14 +217,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt rain, phii, tsfc, & ! input domr, domzr, domip, doms) ! output ! -! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' -! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) -! do i=1,im -! if (abs(xlon(i)*57.29578-114.0) .lt. 0.2 .and. -! & abs(xlat(i)*57.29578-40.0) .lt. 0.2) -! & print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ', -! & DOMR(i),DOMZR(i),DOMIP(i),DOMS(i) -! end do ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson) then diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 9dbd04abd..ddf8cb813 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -98,22 +98,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -897,22 +881,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 042d509bd..f8bbf247e 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +84,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & - hybedmf, do_shoc, satmedmf, qgrs, vdftra, xlon, xlat, lprnt, ipt, kdt, me,errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -99,17 +99,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf - real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt - integer, intent(in) :: kdt, me - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys), parameter :: rad2dg = 180.0/3.14159265359 !local variables integer :: i, k, kk, k1, n @@ -118,29 +112,6 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 - - lprnt = .false. - ipt = 1 -! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & -! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & -! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 -! if (kdt == 1) & -! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & -! ' xlat=',xlat(i)*rad2dg,' me=',me -! if (lprnt) then -! ipt = i -! write(0,*)' GFS_PBL_generic_pre_run ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me -! exit -! endif -! enddo -! if (lprnt) then -! write(0,*)' qgrsv=',qgrs(ipt,:,1) -! write(0,*)' qgrsi=',qgrs(ipt,:,ntiw) -! write(0,*)' qgrsw=',qgrs(ipt,:,ntcw) -! endif - !DH: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then vdftra = qgrs @@ -316,8 +287,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, & - lprnt, ipt, kdt, me, errmsg, errflg) + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -332,11 +302,6 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt - integer, intent(in) :: kdt, me - - real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac, fice diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 120f98a5f..51764e04d 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,56 +307,6 @@ kind = kind_phys intent = inout optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radians - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radians - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1270,38 +1220,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 6db23065c..d8784dc62 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -15,14 +15,14 @@ end subroutine GFS_SCNV_generic_pre_finalize !! \htmlinclude GFS_SCNV_generic_pre_run.html !! subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & - save_t, save_qv, lprnt, ipr, errmsg, errflg) + save_t, save_qv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ipr - logical, intent(in) :: ldiag3d, lprnt + integer, intent(in) :: im, levs + logical, intent(in) :: ldiag3d real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t, save_qv diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index e17682609..79f4eab11 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -61,22 +61,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 8eef89b0b..8abaf24b7 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -468,7 +468,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & imp_physics_gfdl, imp_physics_thompson, & imp_physics_wsm6, imp_physics_fer_hires, prsi, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver, ras, lprnt, ipt, kdt, me, & + work1, work2, kpbl, kinver, ras, me, & clw, rhc, save_qc, save_qi, errmsg, errflg) use machine, only: kind_phys @@ -478,7 +478,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! interface variables integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntlnc, ntinc, & ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, kdt, me + imp_physics_zhao_carr_pdf, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -493,8 +493,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw - logical, intent(inout) :: lprnt - integer, intent(inout) :: ipt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -508,41 +506,12 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 ! in the following inverse of slope_mg and slope_upmg are specified real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & - slope_upmg = 25.0_kind_phys, & - rad2dg = 180.0/3.14159265359 + slope_upmg = 25.0_kind_phys ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - lprnt = .false. - ipt = 1 -! do i=1,im -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-97.50) < 0.101 & -! .and. abs(xlat(i)*rad2dg-24.48) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-293.91) < 0.101 & -! .and. abs(xlat(i)*rad2dg+72.02) < 0.101 -! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-308.88) < 0.101 & -! .and. abs(grid%xlat(i)*rad2dg+29.16) < 0.101 -! lprnt = kdt >= 135 .and. abs(xlon(i)*rad2dg-95.27) < 0.101 & -! .and. abs(xlat(i)*rad2dg-26.08) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-311.08) < 0.101 & -! .and. abs(xlat(i)*rad2dg+28.27) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-113.48) < 0.101 & -! .and. abs(xlat(i)*rad2dg-21.07) < 0.101 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-269.29) < 0.201 & -! .and. abs(xlat(i)*rad2dg-17.45) < 0.201 -! lprnt = kdt >= 1 .and. abs(xlon(i)*rad2dg-169.453) < 0.501 & -! .and. abs(xlat(i)*rad2dg-72.96) < 0.501 -! if (kdt == 1) & -! write(2000+me,*)' i=',i,' xlon=',xlon(i)*rad2dg, & -! ' xlat=',xlat(i)*rad2dg,' me=',me -! if (lprnt) then -! ipt = i -! write(0,*)' ipt=',ipt,'xlon=',xlon(i)*rad2dg,' xlat=',xlat(i)*rad2dg,' me=',me -! exit -! endif -! enddo ! !GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset ! do k=1,levs @@ -615,7 +584,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & rhc(i,k) = min(rhcmax, max(0.7, 1.0-tx2(i)*tem1*tem2)) enddo enddo -! if (kdt == 1 .and. me == 0) write(0,*)' rhc=',rhc(1,:) else do k=1,levs do i=1,im @@ -676,11 +644,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & rhc(:,:) = 1.0 endif ! end if_ntcw -! if (lprnt) write(0,*)' clwice=',clw(ipt,:,1) -! if (lprnt) write(0,*)' clwwat=',clw(ipt,:,2) -! if (lprnt) write(0,*)' rhc=',rhc(ipt,:) -! if (lprnt) write(0,*)' gq01=',gq0(ipt,:,1) - end subroutine GFS_suite_interstitial_3_run end module GFS_suite_interstitial_3 @@ -701,7 +664,7 @@ end subroutine GFS_suite_interstitial_4_finalize subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & - gq0, clw, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, lprnt, ipr, errmsg, errflg) + gq0, clw, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) use machine, only: kind_phys @@ -711,9 +674,9 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to integer, intent(in) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imfdeepcnv, imfdeepcnv_gf, ipr + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imfdeepcnv, imfdeepcnv_gf - logical, intent(in) :: ltaerosol, cplchm, lprnt + logical, intent(in) :: ltaerosol, cplchm real(kind=kind_phys), intent(in) :: con_pi, dtf real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc, gt0 @@ -821,16 +784,6 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo endif -! if (lprnt) then -! write(0,*)' aft shallow physics' -! write(0,*)'qt0s=',gt0(ipr,:) -! write(0,*)'qq0s=',gq0(ipr,:,1) -! write(0,*)'qq0ws=',gq0(ipr,:,ntcw) -! write(0,*)'qq0is=',gq0(ipr,:,ntiw) -! write(0,*)'qq0ntic=',gq0(ipr,:,8) -! write(0,*)'qq0os=',gq0(ipr,:,12) -! endif - end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 8a6b84cb9..f8a8109da 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1429,30 +1429,6 @@ type = logical intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipt] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F [me] standard_name = mpi_rank long_name = current MPI-rank @@ -1791,22 +1767,6 @@ type = integer intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index a70579b1e..2dd0d423d 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -379,10 +379,6 @@ subroutine GFS_surface_composites_post_run ( gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) endif tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) - !tsfc(i) = txl*tsfc_lnd(i) + txi*tsfc_ice(i) + txo*tsfc_ocn(i) - - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 48d477fde..b32843bc1 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -24,16 +24,15 @@ end subroutine shoc_finalize !! \htmlinclude shoc_run.html !! #endif -subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, me, prsl, delp, phii, phil, u, v, omega, rhc, & - supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & - cld_sgs, tke, tkh, wthv_sec, lprnt, ipr, errmsg, errflg) +subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & + con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) implicit none - integer, intent(in) :: ix, nx, nzm, me, ipr, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc - logical, intent(in) :: lprnt + integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! @@ -115,19 +114,13 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - !GFDL lat has no meaning inside of shoc - changed to "1" - -! if(lprnt) write(0,*)' befncpi=',ncpi(ipr,:) -! if(lprnt) write(0,*)' tkh=',tkh(ipr,:) - - call shoc_work (ix, nx, nzm, nzm+1, dtp, me, 1, prsl, delp, & - phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & - rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, lprnt, ipr, & - ntlnc, ncpl, ncpi, & + call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & + ntlnc, ncpl, ncpi, & con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) -! if(lprnt) write(0,*)' aftncpi=',ncpi(ipr,:) if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm do i=1,nx @@ -168,25 +161,21 @@ end subroutine shoc_run ! replacing fac_fus by fac_sub ! S.Moorthi - 00-00-17 - added an alternate option for near boundary cek following ! Scipion et. al., from U. Oklahoma. - subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & + subroutine shoc_work (ix, nx, nzm, nz, dtn, & prsl, delp, phii, phil, u, v, omega, tabs, & qwv, qi, qc, qpi, qpl, rhc, supice, & pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, & - wthv_sec, lprnt, ipr, ntlnc, ncpl, ncpi, & + wthv_sec, ntlnc, ncpl, ncpi, & cp, ggr, lcond, lfus, rv, rgas, pi, epsv) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - logical, intent(in) :: lprnt - integer, intent(in) :: ipr real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x - integer, intent(in) :: me ! MPI rank - integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) @@ -404,13 +393,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,:) -! if (lprnt) write(0,*)' qcin=',qc(ipr,:) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,:) -! if (lprnt) write(0,*)' qiin=',qi(ipr,:) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,:) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,:) -! if (lprnt) write(0,*)' tkein=',tke(ipr,:) ! ! move water from vapor to condensate if the condensate is negative ! @@ -455,9 +437,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,:) -! if (lprnt) write(0,*)' qwvin2=',qwv(ipr,:) - do k=1,nzm do i=1,nx zl(i,k) = phil(i,k) * ggri @@ -485,16 +464,10 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & ! Liquid/ice water static energy - ! Note the the units are degrees K hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & - fac_sub *(qci(i,k)+qpi(i,k)) -! if (lprnt .and. i == ipr .and. k<=10) write(0,*)' hl=',hl(i,k), & -! ' tabs=',tabs(i,k),' gamaz=',gamaz(i,k), ' fac_cond=',fac_cond, & -! ' qcl=',qcl(i,k),' qpl=',qpl(i,k),' qci=',qci(i,k),' qpi=',qpi(i,k),& -! ' fac_sub=',fac_sub,' k=',k w3(i,k) = zero enddo enddo -! if (lprnt) write(0,*)' hlin=',hl(ipr,1:40) - ! Define vertical grid increments for later use in the vertical differentiation do k=2,nzm @@ -546,8 +519,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) ! w_sec(i,k) = max(twoby3 * tke(i,k), zero) -! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,k),' tke=',tke(i,k),& -! ' tkh=',tkh(i,ka),tkh(i,kb),' w=',w(i,ku),w(i,kd),' prnum=',prnum(i,ka),prnum(i,kb),' k=',k else w_sec(i,k) = zero endif @@ -616,11 +587,6 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, me, lat, & call assumed_pdf() -! if (lprnt) write(0,*)' tabsout=',tabs(ipr,1:40) -! if (lprnt) write(0,*)' qcout=',qc(ipr,1:40) -! if (lprnt) write(0,*)' qwvout=',qwv(ipr,1:40) -! if (lprnt) write(0,*)' qiout=',qi(ipr,1:40) - contains subroutine tke_shoc() @@ -727,23 +693,12 @@ subroutine tke_shoc() wrk = (dtn*Cee) / smixt(i,k) wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& -! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=', & -! smixt(i,k),' tkh=',tkh(i,ku),tkh(i,kd),' def2=',def2(i,ku),def2(i,kd) & -! ,' prnum=',prnum(i,ku),prnum(i,kd),' wthv_sec=',wthv_sec(i,k),' thv=',thv(i,k) - do itr=1,nitr ! iterate for implicit solution wtke = min(max(min_tke, wtke), max_tke) a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term wtke = wrk1 / (one+a_diss) wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& -! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu, & -! ' wrk1=',wrk1,' itr=',itr,' k=',k - wtk2 = wtke - enddo tke(i,k) = min(max(min_tke, wtke), max_tke) @@ -763,9 +718,6 @@ subroutine tke_shoc() tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) endif -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' isotropy=',isotropy(i,k),& -! ' buoy_sgs=',buoy_sgs,' lambda=',lambda,' tscale1=',tscale1 - ! TKE budget terms ! tkesbdiss(i,k) = a_diss @@ -783,8 +735,6 @@ subroutine tke_shoc() tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity enddo ! i -! if (lprnt) write(0,*)' shocendtkh=',tkh(ipr,k),' tke=',tke(ipr,k),& -! tke(ipr,k1),' isot=',isotropy(ipr,k),isotropy(ipr,k1),'k=',k,' k1=',k1 enddo ! k @@ -1222,7 +1172,7 @@ subroutine canuto() ! In the presence of strong vertical gradients of w2, the value interpolated to the interface can ! be as much as twice as as large (or as small) as the value on in layer center. When the skewness ! of W PDF is calculated in assumed_pdf(), the code there uses w2 on the layer center, and the value -! of w3 interpolated from the interfaces to the layer center. The errorsintroduced due to dual +! of w3 interpolated from the interfaces to the layer center. The errors introduced due to dual ! interpolation are amplified by exponentiation during the calculation of skewness ! and result in (ususally negative) values ! of skewness of W PDF that are too large ( < -10). The resulting PDF consists of two delta @@ -1377,7 +1327,6 @@ subroutine assumed_pdf() ! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' w_sec=',w_sec(i,k),' k=',k if (w_sec(i,k) > zero) then sqrtw2 = sqrt(w_sec(i,k)) else @@ -1444,8 +1393,6 @@ subroutine assumed_pdf() ! Find parameters of the PDF of liquid/ice static energy -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& -! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN thl1_1 = thl_first thl1_2 = thl_first @@ -1475,14 +1422,9 @@ subroutine assumed_pdf() thl2_2 = zero endif ! -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& -! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 - thl1_1 = thl1_1*sqrtthl + thl_first thl1_2 = thl1_2*sqrtthl + thl_first -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 - sqrtthl2_1 = sqrt(thl2_1) sqrtthl2_2 = sqrt(thl2_2) @@ -1504,9 +1446,6 @@ subroutine assumed_pdf() qw1_1 = - corrtest2 / w1_2 ! A.7 qw1_2 = - corrtest2 / w1_1 ! A.8 -! if (lprnt .and. i == ipr .and. k<10) write(0,*)' qw1_1=',qw1_1,' corrtest2=',corrtest2,& -! ' w1_2=',w1_2,' wqwsec=',wqwsec,' sqrtw2=',sqrtw2,' sqrtqt=',sqrtqt,' qwsec=',qwsec - tsign = abs(qw1_2-qw1_1) ! Skew_qw = skew_facw*Skew_w @@ -1566,9 +1505,6 @@ subroutine assumed_pdf() Tl1_1 = thl1_1 - gamaz(i,k) Tl1_2 = thl1_2 - gamaz(i,k) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& -! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,k),' qpi=',qpi(i,k) - ! Now compute qs ! Partition based on temperature for the first plume @@ -1576,7 +1512,6 @@ subroutine assumed_pdf() IF (Tl1_1 >= tbgmax) THEN lstarn1 = lcond esval = min(fpvsl(Tl1_1), pval) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' esval=',esval,' pval=',pval,' eps=',eps qs1 = eps * esval / (pval-0.378d0*esval) ELSE IF (Tl1_1 <= tbgmin) THEN lstarn1 = lsub @@ -1640,8 +1575,6 @@ subroutine assumed_pdf() s1 = qw1_1 - wrk ! A.17 cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc s1=',s1,' qw1_1=',qw1_1,'wrk=',wrk,& -! ' qs1=',qs1,' beta1=',beta1,' cqt1=',cqt1 wrk1 = cthl1 * cthl1 wrk2 = cqt1 * cqt1 ! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) @@ -1655,9 +1588,6 @@ subroutine assumed_pdf() wrk = s1 / (std_s1*sqrt2) C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=',s1,'std=',std_s1,& -! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k - IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 ELSEIF (s1 >= qcmin) THEN C1 = one @@ -1716,11 +1646,6 @@ subroutine assumed_pdf() qi1 = qn1 - ql1 qi2 = qn2 - ql2 -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& -! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& -! ,' tbgmin=',tbgmin,'a_bg=',a_bg - - diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) diag_qi = diag_qn - diag_ql @@ -1733,10 +1658,6 @@ subroutine assumed_pdf() + fac_sub *(diag_qi+qpi(i,k)) & + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating -! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,k),' k=',k& -! ,' hl=',hl(i,k),' gamaz=',gamaz(i,k),' diag_ql=',diag_ql,' qpl=',qpl(i,k)& -! ,' diag_qi=',diag_qi,' qpi=',qpi(i,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& -! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index fb4d7e515..07f014356 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -124,14 +124,6 @@ kind = kind_phys intent = in optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -411,22 +403,6 @@ kind = kind_phys intent = inout optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 694060acd..f0947b9b4 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -20,7 +20,7 @@ module m_micro !! \htmlinclude m_micro_init.html !! subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair,& - tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & + eps, tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & @@ -38,7 +38,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, sed_supersat, do_sb_physics, mg_do_hail, & mg_do_graupel, mg_nccons, mg_nicons, mg_ngcons, & mg_do_ice_gmao, mg_do_liq_liu - real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, tmelt, latvap, latice + real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, eps, tmelt, latvap, latice real(kind=kind_phys), intent(in) :: mg_dcs, mg_qcvar, mg_ts_auto_ice(2), mg_rhmini, & mg_berg_eff_factor, mg_ncnst, mg_ninst, mg_ngnst character(len=16), intent(in) :: mg_precip_frac_method @@ -60,7 +60,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1)) elseif (fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & microp_uniform, do_cldice, & @@ -73,7 +73,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, mg_ncnst, mg_ninst) elseif (fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & mg_do_hail, mg_do_graupel, & @@ -136,9 +136,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & &, CLDREFFG, aerfld_i & &, aero_in, naai_i, npccn_i, iccn & &, skip_macro & - &, lprnt, alf_fac, qc_min, pdfflag & - &, ipr, kdt, xlat, xlon, rhc_i, & - & me, errmsg, errflg) + &, alf_fac, qc_min, pdfflag & + &, kdt, xlat, xlon, rhc_i, & + & errmsg, errflg) use machine , only: kind_phys use physcons, grav => con_g, pi => con_pi, & @@ -182,8 +182,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag, me - logical,intent(in) :: flipv, aero_in, skip_macro, lprnt, iccn + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, aero_in, skip_macro, iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & @@ -379,7 +379,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & type (AerProps) :: AeroAux, AeroAux_b real, allocatable, dimension(:,:,:) :: AERMASSMIX - logical :: use_average_v, ltrue, lprint + logical :: use_average_v, ltrue, lprint, lprnt + integer :: ipr !================================== !====2-moment Microhysics= @@ -407,6 +408,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & errmsg = '' errflg = 0 + lprnt = .false. + ipr = 1 + ! rhr8 = 1.0 if(flipv) then DO K=1, LM diff --git a/physics/m_micro.meta b/physics/m_micro.meta index b3a42c709..7fc28c8a9 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -61,6 +61,15 @@ kind = kind_phys intent = in optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [tmelt] standard_name = triple_point_temperature_of_water long_name = triple point temperature of water @@ -823,14 +832,6 @@ type = logical intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F [alf_fac] standard_name = mg_tuning_factor_for_alphas long_name = tuning factor for alphas (alpha = 1 - critical relative humidity) @@ -857,14 +858,6 @@ type = integer intent = in optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration @@ -900,14 +893,6 @@ kind = kind_phys intent = in optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 6588a375a..135c11e49 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -95,7 +95,6 @@ module micro_mg2_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -183,7 +182,7 @@ module micro_mg2_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -200,7 +199,7 @@ module micro_mg2_0 !>\ingroup mg2_0_mp !! This subroutine calculates subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & @@ -226,6 +225,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -321,6 +322,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 @@ -1678,7 +1680,7 @@ subroutine micro_mg_tend ( & if (do_cldice) then call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), & - cldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & + icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) do i=1,mgncol diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 9a9971df5..047f9ef8a 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -124,7 +124,6 @@ module micro_mg3_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -232,7 +231,7 @@ module micro_mg3_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4, gamma_bg_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -247,7 +246,7 @@ module micro_mg3_0 !=============================================================================== subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & !++ag @@ -277,6 +276,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -408,6 +409,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 560d6bbfe..eb6ccd7e7 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -31,7 +31,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & prsi,del,prsl,prslk,phii,phil,delt, & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & lprnt,ipr,me, & grav, rd, cp, hvap, fv, & errmsg,errflg) ! @@ -42,9 +41,8 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - logical, intent(in) :: lprnt integer, intent(in) :: ix, im, - & km, ntrac, ntcw, ncnd, ntke, ipr, me + & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver real(kind=kind_phys), intent(in) :: delt, @@ -119,14 +117,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! -! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) -! &, ' grav=',grav, rd, cp, hvap, fv,' ipr=',ipr -! &,' ntke=',ntke,' ntcw=',ntcw -! if (lprnt) write(0,*)' in moninshoc tin=',t1(ipr,:) -! if (lprnt) write(0,*)' in moninshoc qin=',q1(ipr,:,1) -! if (lprnt) write(0,*)' in moninshoc qwin=',q1(ipr,:,2) -! if (lprnt) write(0,*)' in moninshoc qiin=',q1(ipr,:,3) - dt2 = delt rdt = 1. / dt2 km1 = km - 1 @@ -170,12 +160,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo enddo - -! if (lprnt) then -! write(0,*)' tx1=',tx1(ipr),' kinver=',kinver(ipr) -! write(0,*)' xkzo=',xkzo(ipr,:) -! write(0,*)' xkzmo=',xkzmo(ipr,:) -! endif ! ! diffusivity in the inversion layer is set to be xkzminv (m^2/s) ! @@ -219,7 +203,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! -! if (lprnt) write(0,*)' heat=',heat(ipr),' evap=',evap(ipr) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. @@ -380,9 +363,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, dkt(i,k) = max(min(tkh(i,kp1)+xkzo(i,k), dkmax), xkzo(i,k)) enddo enddo - -! if (lprnt) write(0,*)' tkh=',tkh(ipr,:) -! if (lprnt) write(0,*)' dkt=',dkt(ipr,:) ! ! compute tridiagonal matrix elements for heat and moisture ! @@ -391,8 +371,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo -! if (lprnt) write(0,*)' a1=',a1(ipr,1),' beta=',beta(ipr) -! &,' heat=',heat(ipr), ' t1=',t1(ipr,1) ntloc = 1 if(ntrac > 1) then @@ -557,8 +535,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif ! -! if (lprnt) write(0,*)' in moninshoc tau=',tau(ipr,:)*86400 - return end subroutine moninshoc_run diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 480cc419d..80d8f71fc 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -424,30 +424,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = flag for printing diagnostics to output - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [grav] standard_name = gravitational_acceleration long_name = gravitational acceleration diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 7ae82acca..be3b928a8 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -5,12 +5,6 @@ module rascnv USE machine , ONLY : kind_phys - use physcons, grav => con_g, cp => con_cp, alhl => con_hvap& - &, alhf => con_hfus, rgas => con_rd, rkap => con_rocp& - &, nu => con_FVirt, pi => con_pi, t0c => con_t0c & - &, rv => con_rv, cvap => con_cvap & - &, cliq => con_cliq, csol => con_csol, ttp=> con_ttp & - &, eps => con_eps, epsm1 => con_epsm1 implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private @@ -36,27 +30,16 @@ module rascnv &, ONE_M6=1.E-6, ONE_M5=1.E-5 & &, ONE_M2=1.E-2, ONE_M1=1.E-1 & &, oneolog10=one/log(10.0) & - &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0 ! Conversion from hPa to Pa ! - real(kind=kind_phys), parameter :: & - & ONEBG = ONE / GRAV, GRAVCON = cmb2pa * ONEBG & - &, onebcp = one / cp & - &, GRAVFAC = GRAV / CMB2PA, ELOCP = ALHL * onebcp & - &, ELFOCP = (ALHL+ALHF) * onebcp & - &, oneoalhl = one/alhl & - &, CMPOR = CMB2PA / RGAS & - &, picon = half*pi*onebg & - &, zfac = 0.28888889E-4 * ONEBG -! - real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & &, rhfacs=0.70, rhfacl=0.70 & &, face=5.0, delx=10000.0 & &, ddfac=face*delx*0.001 & &, max_neg_bouy=0.15 & ! &, max_neg_bouy=pt25 & + &, testmb=0.1, testmbi=one/testmb & &, dpd=0.5, rknob=1.0, eknob=1.0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -69,9 +52,6 @@ module rascnv ! &, advcld=.true., advups=.false.,advtvd=.false. -! real(kind=kind_phys), parameter :: TF=160.16, TCR=160.16 & -! real(kind=kind_phys), parameter :: TF=230.16, TCR=260.16 & -! real(kind=kind_phys), parameter :: TF=233.16, TCR=263.16 & real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & &, TCRF=1.0/(TCR-TF), TCL=2.0 @@ -97,13 +77,20 @@ module rascnv real(kind=kind_phys) AC(16), AD(16) ! integer, parameter :: nqrp=500001 - real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & + real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & &, TBQRB(NQRP) ! integer, parameter :: nvtp=10001 real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) ! - real(kind=kind_phys) afc, facdt + real(kind=kind_phys) afc, facdt, & + grav, cp, alhl, alhf, rgas, rkap, nu, pi, & + t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& +! + ONEBG, GRAVCON, onebcp, GRAVFAC, ELOCP, & + ELFOCP, oneoalhl, CMPOR, picon, zfac, & + deg2rad, PIINV, testmboalhl, & + rvi, facw, faci, hsub, tmix, DEN contains @@ -117,12 +104,19 @@ module rascnv !> \section arg_table_rascnv_init Argument Table !! \htmlinclude rascnv_init.html !! - subroutine rascnv_init(me, dt, errmsg, errflg) + subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & + con_rv, con_hvap, con_hfus, con_fvirt, & + con_t0c, con_ttp, con_cvap, con_cliq, & + con_csol, con_eps, con_epsm1, & + errmsg, errflg) ! Implicit none ! integer, intent(in) :: me - real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), intent(in) :: dt, & + con_g, con_cp, con_rd, con_rv, con_hvap, & + con_hfus, con_fvirt, con_t0c, con_cvap, con_cliq, & + con_csol, con_ttp, con_eps, con_epsm1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -174,6 +168,27 @@ subroutine rascnv_init(me, dt, errmsg, errflg) ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + grav = con_g ; cp = con_cp ; alhl = con_hvap + alhf = con_hfus ; rgas = con_rd + nu = con_FVirt ; t0c = con_t0c + rv = con_rv ; cvap = con_cvap + cliq = con_cliq ; csol = con_csol ; ttp = con_ttp + eps = con_eps ; epsm1 = con_epsm1 +! + pi = four*atan(one) ; PIINV = one/PI + ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG + onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA + rkap = rgas * onebcp ; deg2rad = pi/180.d0 + ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp + oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS + picon = half*pi*onebg ; zfac = 0.28888889E-4 * ONEBG + testmboalhl = testmb/alhl +! + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0 ; DEN=one/(TTP-TMIX) +! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD @@ -249,8 +264,6 @@ end subroutine rascnv_finalize !! qw0 - real, min cloud water before autoconversion !! qi0 - real, min cloud ice before autoconversion !! dlqfac - real,fraction of condensated detrained in layers -!! lprnt - logical, true for debug print -!! ipr - integer, horizontal grid point to print when lprnt=true !! kdt - integer, current teime step !! revap - logial, when true reevaporate falling rain/snow !! qlcn - real @@ -277,8 +290,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, ccwf, area, dxmin, dxinv & &, psauras, prauras, wminras, dlqf, flipv & &, me, rannum, nrcm, mp_phys, mp_phys_mg & - &, ntk, lprnt, ipr, kdt, rhc & -! &, ntk, lprnt, ipr, kdt, trcmin, rhc & + &, ntk, kdt, rhc & &, tin, qin, uin, vin, ccin, fscav & &, prsi, prsl, prsik, prslk, phil, phii & &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & @@ -305,12 +317,12 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! Implicit none ! - LOGICAL FLIPV, lprnt + LOGICAL FLIPV ! ! input ! - integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, ipr & - &, kdt, mp_phys, mp_phys_mg + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + &, mp_phys, mp_phys_mg integer, dimension(im) :: kbot, ktop, kcnv, kpbl ! real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & @@ -369,9 +381,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd real(kind=kind_phys) sgcs(k,im) -! - LOGICAL lprint -! LOGICAL lprint, ctei ! ! Scavenging related parameters ! @@ -390,14 +399,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & errmsg = '' errflg = 0 - -! if (me == 0) write(0,*)' in ras ntr=',ntr,' kdt=',kdt,' ntk=',ntk -! if (me == 0) write(0,*)' in ras tke=',ccin(1,:,ntk),' kdt=',kdt & -! &, ' ntk=',ntk -! if (me == 0) write(0,*)' rann=',rannum(1,:),' kdt=',kdt -! if (lprnt) write(0,*)' in RAS fscav=',fscav_, ' mp_phys=',mp_phys & -! &, ' fscav=',fscav,' ntr=',ntr & -! &, ' rannum=',rannum(1,:) ! km1 = k - 1 kp1 = k + 1 @@ -406,7 +407,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & else ksfc = kp1 endif - ia = ipr ! ntrc = ntr IF (CUMFRC) THEN @@ -458,9 +458,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo DO IPT=1,IM - lprint = lprnt .and. ipt == ipr - ia = ipr - tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) tem2 = one - tem1 ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 @@ -470,9 +467,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem if (ccwfac == zero) ccwfac = half -! if (lprint) write(0,*)' c0=',c0,' c0i=',c0i,' dlq_fac=',dlq_fac, & -! & ' ccwf=',ccwf - ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -506,9 +500,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ENDDO krmin = max(krmin,2) -! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx -! if (lprint) write(0,*)' krmin=',krmin,' krmax=', & -! &krmax,' kfmax=',kfmax,' tem=',tem ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 @@ -530,11 +521,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprint)write(0,*)' enter RASCNV k=',k,' ktem=',ktem & -! &, ' krmax=',krmax,' kfmax=',kfmax & -! &, ' krmin=',krmin,' ncrnd=',ncrnd & -! &, ' kcr=',kcr, ' cdrag=',cdrag(ipr) - IF (KFX > 0) THEN IF (BOTOP) THEN DO NC=1,KFX @@ -556,19 +542,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ENDDO ENDIF ! -! if (me == 0) write(0,*)' in rascnv: k=',k,' lprnt=',lprnt -! if (lprint) then -! if (me == 0) then -! write(0,*)' ic=',ic(1:kfx+ncrnd) -! write(0,*)' tin',(tin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me -! write(0,*)' qin',(qin(ia,l),l=k,1,-1),' kdt=',kdt,' me=',me -! write(0,*)' qwin',(ccin(ia,l,2),l=k,1,-1) -! write(0,*)' qiin',(ccin(ia,l,1),l=k,1,-1) -! endif -! -! -! lprint = lprnt .and. ipt == ipr - do l=1,k CLW(l) = zero CLI(l) = zero @@ -687,18 +660,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! end of if (flipv) then ! -! if (lprint) write(0,*)' phi_h=',phi_h(:) -! lprint = kdt == 1 .and. me == 0 .and. ipt == 1 -! if(lprint) write(0,*)' PRS=',PRS -! if(lprint) write(0,*)' PRSM=',PRSM -! if (lprint) then -! write(0,*)' qns=',qns(ia),' qoi=',qn0(ia,k),'qin=',qin(ia,1) -! if (me == 0) then -! write(0,*)' toi',(tn0(ia,l),l=1,k) -! write(0,*)' qoi',(qn0(ia,l),l=1,k),' kbl=',kbl -! endif -! -! ! do l=k,kctop(1),-1 !! DPI(L) = 1.0 / (PRS(L+1) - PRS(L)) ! enddo @@ -806,16 +767,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & enddo endif ! -! lprint = lprnt .and. ipt == ipr - -! if (lprint) then -! write(0,*)' trcfac=',trcfac(krmin:k,1+ntr) -! write(0,*)' alfint=',alfint(krmin:k,1) -! write(0,*)' alfinq=',alfint(krmin:k,2) -! write(0,*)' alfini=',alfint(krmin:k,4) -! write(0,*)' alfinu=',alfint(krmin:k,5) -! endif -! ! if (calkbl) kbl = k if (calkbl) then @@ -829,11 +780,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & IB = IC(NC) ! cloud top level index if (ib > kbl-1) cycle -! lprint = lprnt .and. ipt == ipr .and. ib == 57 -! -! if (lprint) write(0,*)' calling cloud type ib=',ib,' kbl=',kbl& -! &, ' kpbl=',kpbl,' alfint=',alfint,' frac=',frac & -! &, ' ntrc=',ntrc,' ipt=',ipt ! !**************************************************************************** ! if (advtvd) then ! TVD flux limiter scheme for updraft @@ -897,48 +843,23 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! endif ! endif !**************************************************************************** -! -! if (lprint) then -! ia = ipt -! write(0,*)' toi=',(toi(ia,l),l=1,K) -! write(0,*)' qoi=',(qoi(ia,l),l=1,K),' kbl=',kbl -! write(0,*)' toi=',(toi(l),l=1,K) -! write(0,*)' qoi=',(qoi(l),l=1,K),' kbl=',kbl -! write(0,*)' prs=',(prs(l),l=1,K) -! endif ! WFNC = zero do L=IB,KP1 FLX(L) = zero FLXD(L) = zero enddo -! -! if(lprint)then -! write(0,*) ' CALLING CLOUD TYPE IB= ', IB,' DT=',DT,' K=',K -! &, 'ipt=',ipt -! write(0,*) ' TOI=',(TOI(L),L=IB,K) -! write(0,*) ' QOI=',(QOI(L),L=IB,K) -! write(0,*) ' qliin=',qli -! write(0,*) ' qiiin=',qii -! endif ! TLA = -10.0 ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection ! -! if(lprint) write(0,*)' uvitke=',uvi(ib:k,ntk-2), ' ib=',ib & -! &,' trcmin=',trcmin(ntk-2) -! if (lprnt) then -! qoi_l(ib:k) = qoi(ib:k) -! qli_l(ib:k) = qli(ib:k) -! qii_l(ib:k) = qii(ib:k) -! endif rainp = rain CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & - &, REVAP, WRKFUN, CALKBL, CRTFUN, lprint & + &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, rhfacl, rhfacs, area(ipt) & &, ccwfac, CDRAG(ipt), trcfac & @@ -949,25 +870,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, dlq_fac) ! &, ctei) -! if(lprint) write(0,*)' uvitkea=',uvi(ib:k,ntk-2),' ib=',ib -! if (lprint) then -! write(0,*) ' rain=',rain,' ipt=',ipt -! write(0,*) ' after calling CLOUD TYPE IB= ', IB & -! &,' rain=',rain,' prskd=',prs(ib),' qli=',qli(ib),' qii=',qii(ib) & -! &,' rainp=',rainp -! write(0,*) ' phi_h=',phi_h(K-5:KP1) -! write(0,*) ' TOI=',(TOI(L),L=1,K),' me=',me,' ib=',ib -! write(0,*) ' QOI=',(QOI(L),L=1,K) -! write(0,*) ' qliou=',qli -! write(0,*) ' qiiou=',qii -! sumq = 0.0 -! do l=ib,k -! sumq = sumq+(qoi(l)+qli(l)+qii(l)-qoi_l(l)-qli_l(l)-qii_l(l)) -! & * (prs(l+1)-prs(l)) * (100.0/grav) -! enddo -! write(0,*)' sumq=',sumq,' rainib=',rain-rainp,' ib=',ib - -! endif ! if (flipv) then do L=IB,K @@ -980,14 +882,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 -! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ll=',ll -! &,' ud_mf=',ud_mf(ipt,:) - CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt -! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ll) -! &,' ll=',ll,' kp1=',kp1 - ! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & @@ -1006,11 +902,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 -! if (lprint) write(0,*)' ib=',ib,' flx=',flx(ib),' ib=',ib -! &,' ud_mf=',ud_mf(ipt,:) CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt -! if (lprint) write(0,*)' ib=',ib,' CNV_MFD=',CNV_MFD(ipt,ib) -! &,' ib=',ib,' kp1=',kp1 ! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) ! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & @@ -1022,7 +914,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif ! ! -! Warining!!!! +! Warning!!!! ! ------------ ! By doing the following, CLOUD does not contain environmental ! condensate! @@ -1040,13 +932,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! RAINC(ipt) = rain * 0.001 ! Output rain is in meters -! if (lprint) then -! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' & -! &, ' ipt=',ipt,' kdt=',kdt -! write(0,*) ' toi',(tn0(imax,l),l=1,k) -! write(0,*) ' qoi',(qn0(imax,l),l=1,k) -! endif -! ktop(ipt) = kp1 kbot(ipt) = 0 @@ -1093,14 +978,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & QICN(ipt,ll) = qii(l) CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) endif -!! CNV_PRC3(ipt,ll) = PCU(l)/dt -! CNV_PRC3(ipt,ll) = zero -! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & & 500*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) -! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) -! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) @@ -1128,11 +1008,6 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ktop(ipt) = kp1 - ktop(ipt) kbot(ipt) = kp1 - kbot(ipt) -! -! if (lprint) then -! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) -! endif ! else @@ -1184,23 +1059,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & endif endif ! -! if (lprint) then -! write(0,*) ' endtin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' endqin',(qin(ia,l),l=k,1,-1) -! write(0,*) ' endqwin',(ccin(ia,l,2),l=k,1,-1) -! write(0,*) ' endqiin',(ccin(ia,l,1),l=k,1,-1) -! endif -! -! ! Velocity scale from the downdraft! ! -! if (lprint) write(0,*)' ddvelbef=',ddvel(ipt),' ddfac=',ddfac & -! &, 'grav=',grav,' k=',k,'kp1=',kp1,'prs=',prs(k),prs(kp1) - DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) - -! if (lprint) write(0,*)' ddvel=',ddvel(ipt),' ddfac=',ddfac - ! ENDDO ! End of the IPT Loop! @@ -1211,7 +1072,7 @@ end subroutine rascnv_run SUBROUTINE CLOUD( & & K, KP1, KD, NTRC, KBLMX, kblmn & &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & - &, REVAP, WRKFUN, CALKBL, CRTFUN, lprnt & + &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & @@ -1292,8 +1153,6 @@ SUBROUTINE CLOUD( & &, qudfac=quad_lam*half & &, shalfac=3.0 & ! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's - &, testmb=0.1, testmbi=one/testmb& - &, testmboalhl=testmb/alhl & &, c0ifac=0.07 & ! following Han et al, 2016 MWR &, dpnegcr = 150.0 ! &, dpnegcr = 100.0 @@ -1313,7 +1172,7 @@ SUBROUTINE CLOUD( & ! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP - logical vsmooth, do_aw, lprnt + logical vsmooth, do_aw INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk @@ -1400,16 +1259,6 @@ SUBROUTINE CLOUD( & tcd(L) = zero qcd(L) = zero enddo -! -! if (lprnt) then -! write(0,*) ' IN CLOUD for KD=',kd -! write(0,*) ' prs=',prs(Kd:KP1) -! write(0,*) ' phil=',phil(KD:K) -!! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt -! write(0,*) ' phih=',phih(KD:KP1) -! write(0,*) ' toi=',toi(kd:k) -! write(0,*) ' qoi=',qoi(kd:k) -! endif ! CLDFRD = zero DOF = zero @@ -1454,7 +1303,6 @@ SUBROUTINE CLOUD( & AKT(L) = (PRL(L+1) - PL) * DPI ! CALL QSATCN(TL, PL, QS, DQS) -! CALL QSATCN(TL, PL, QS, DQS,lprnt) ! QST(L) = QS GAM(L) = DQS * ELOCP @@ -1520,22 +1368,9 @@ SUBROUTINE CLOUD( & HOL(L) = HOL(L) + ETA(L) HST(L) = HST(L) + ETA(L) ! -! if (kd == 37) then -! if (lprnt) then -! write(0,*) ' IN CLOUD for KD=',KD,' K=',K -! write(0,*) ' l=',l,' hol=',hol(l),' hst=',hst(l) -! write(0,*) ' TOL=',tol -! write(0,*) ' qol=',qol -! write(0,*) ' hol=',hol -! write(0,*) ' hst=',hst -! endif -! endif -! ! To determine KBL internally -- If KBL is defined externally ! the following two loop should be skipped ! -! if (lprnt) write(0,*) ' calkbl=',calkbl - hcrit = hcritd if (sgcs(kd) > 0.65) hcrit = hcrits IF (CALKBL) THEN @@ -1595,7 +1430,6 @@ SUBROUTINE CLOUD( & enddo endif -! if(lprnt) write(0,*)' kbl=',kbl,' kbls=',kbls,' kmax=',kmax ! klcl = kd1 if (kmax > kd1) then @@ -1606,7 +1440,6 @@ SUBROUTINE CLOUD( & endif enddo endif -! if(lprnt) write(0,*)' klcl=',klcl,' ii=',ii ! if (klcl == kd .or. klcl < ktem) return ! This is to handle mid-level convection from quasi-uniform h @@ -1625,7 +1458,6 @@ SUBROUTINE CLOUD( & tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii -! if(lprnt) write(0,*)' kbl2=',kbl,' ii=',ii if (kbl .ne. ii) then if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) @@ -1659,30 +1491,19 @@ SUBROUTINE CLOUD( & KPBL = KBL -! if(lprnt)write(0,*)' 1st kbl=',kbl,' kblmx=',kblmx,' kd=',kd -! if(lprnt)write(0,*)' tx3=',tx3,' tx1=',tx1,' tem=',tem & -! &, ' hcrit=',hcrit - ELSE KBL = KPBL -! if(lprnt)write(0,*)' 2nd kbl=',kbl ENDIF - -! if(lprnt)write(0,*)' after CALKBL l=',l,' hol=',hol(l) & -! &, ' hst=',hst(l) ! KBL = min(kmax,MAX(KBL,KD+2)) KB1 = KBL - 1 !! -! if (lprnt) write(0,*)' kbl=',kbl,' prlkbl=',prl(kbl),prl(kp1) if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then ! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then return endif ! -! if (lprnt) write(0,*)' kbl=',kbl -! write(0,*)' kbl=',kbl,' kmax=',kmax,' kmaxp1=',kmaxp1,' k=',k ! PRIS = ONE / (PRL(KP1)-PRL(KBL)) PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) @@ -1704,7 +1525,6 @@ SUBROUTINE CLOUD( & ETA(L) = ZET(L) - ZET(L+1) GMS(L) = XI(L) - XI(L+1) ENDIF -! if (lprnt) write(0,*)' l=',l,' eta=',eta(l),' kbl=',kbl ENDDO if (kmax < k) then do l=kmaxp1,kp1 @@ -1732,7 +1552,6 @@ SUBROUTINE CLOUD( & ! qbl = qbl * hpert_fac ! endif -! if (lprnt) write(0,*)' hbl=',hbl,' qbl=',qbl ! Find Min value of HOL in TX2 TX2 = HOL(KD) IDH = KD1 @@ -1766,13 +1585,6 @@ SUBROUTINE CLOUD( & cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & & .AND. TX1 < RHRAM -! if(lprnt) write(0,*)' cnvflg=',cnvflg,' tem=',tem,' tem1=',tem1 & -! &,' tx1=',tx1,' rhram=',rhram,' kbl=',kbl,' kd=',kd,' lowest=' & -! &,lowest,' rhfacs=',rhfacs,' ltl=',ltl(kd1),' qol=',qol(kd1) & -! &,' qst=',qst(kd1),' hst=',hst(kd1),' nu=',nu -! if(lprnt .and. (.not. cnvflg)) write(0,*)' tx1=',tx1,' rhfacs=' & -! &,rhfacs, ' tem=',tem,' hst=',hst(kd1) - IF (.NOT. cnvflg) RETURN ! RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) @@ -1796,9 +1608,6 @@ SUBROUTINE CLOUD( & endif endif -! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', & -! & rbl(ntk),' ntk=',ntk - endif ! TX4 = zero @@ -1808,7 +1617,6 @@ SUBROUTINE CLOUD( & DO L=KBL,K QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) ENDDO -! if (lprnt) write(0,*)' qil=',qil(kbl:k),' gaf=',gaf(kbl) ! DO L=KB1,KD1,-1 lp1 = l + 1 @@ -1818,10 +1626,6 @@ SUBROUTINE CLOUD( & ! FCO(LP1) = TEM1 + ST2 * HBL -! if(lprnt) write(0,*)' fco=',fco(l+1),' tem1=',tem1,' st2=',st2 & -! &,' hbl=',hbl,' tx3=',tx3,' tem=',tem,' gaf=',gaf(l),' l=',l & -! &,'gaflp1=',gaf(lp1),' half=',half,' qst=',qst(l),' hst=',hst(l) - RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 ! @@ -1831,8 +1635,6 @@ SUBROUTINE CLOUD( & ! QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE -! if (lprnt) write(0,*)' qil=',qil(l),' qll=',qll(lp1), & -! & ' rcr=',tcr,' tcl=',tcl,' tcrf=',tcrf ENDDO ! ! FOR THE CLOUD TOP -- L=KD @@ -1861,12 +1663,6 @@ SUBROUTINE CLOUD( & QIL(KD) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(KD))*TCRF)) QLL(KD1) = (half*ALHF) * ST2 * (QIL(KD) + QIL(KD1)) + ONE QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE -! -! if (lprnt) then -! write(0,*)' fco=',fco(kd:kbl) -! write(0,*)' qil=',qil(kd:kbl) -! write(0,*)' qll=',qll(kd:kbl) -! endif ! st1 = qil(kd) st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) @@ -1886,13 +1682,8 @@ SUBROUTINE CLOUD( & ! tem1 = (one-akt(l)) * eta(l) -! if(lprnt) write(0,*)' qll=',qll(l),' st2=',st2,' tem=',tem & -! &,' tx2=',tx2,' akt=',akt(l),' eta=',eta(l) - AKT(L) = QLL(L) + (st2 + tem) * tx2 -! if(lprnt) write(0,*)' akt==',akt(l),' l==',l - AKC(L) = one / AKT(L) ! st1 = half * (qil(l)+qil(lp1)) @@ -1909,15 +1700,10 @@ SUBROUTINE CLOUD( & GMH(L) = GMH(L) + tx1*xi(lp1) ENDDO -! if(lprnt) write(0,*)' akt=',akt(kd:kb1) -! if(lprnt) write(0,*)' akc=',akc(kd:kb1) - qw00 = qw0 qi00 = qi0 ii = 0 777 continue -! -! if (lprnt) write(0,*)' after 777 ii=',ii,' ep_wfn=',ep_wfn ! ep_wfn = .false. RNN(KBL) = zero @@ -1926,8 +1712,6 @@ SUBROUTINE CLOUD( & TX5 = zero DO L=KB1,KD1,-1 TEM = BKC(L-1) * AKC(L) -! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(l),' akc=',akc(l) & -! &,' bkc=',bkc(l-1), ' l=',l TX3 = (TX3 + FCO(L)) * TEM TX4 = (TX4 + RNN(L)) * TEM TX5 = (TX5 + GMH(L)) * TEM @@ -1938,8 +1722,6 @@ SUBROUTINE CLOUD( & HSD = HBL ENDIF ! -! if (lprnt) write(0,*)' tx3=',tx3,' fco=',fco(kd),' akc=',akc(kd) - TX3 = (TX3 + FCO(KD)) * AKC(KD) TX4 = (TX4 + RNN(KD)) * AKC(KD) TX5 = (TX5 + GMH(KD)) * AKC(KD) @@ -1947,8 +1729,6 @@ SUBROUTINE CLOUD( & ! HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) -! if (lprnt) write(0,*)' hsu=',hsu,' hst=',hst(kd), & -! &' ltl=',ltl(kd),' qol=',qol(kd),' qst=',qst(kd) ! !===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER ! @@ -1963,8 +1743,6 @@ SUBROUTINE CLOUD( & ! ! MODIFY HSU TO INCLUDE CLOUD LIQUID WATER AND ICE TERMS ! -! if (lprnt) write(0,*)' hsu=',hsu,' alm=',alm,' tx3=',tx3 - HSU = HSU - ALM * TX3 ! CLP = ZERO @@ -1976,9 +1754,6 @@ SUBROUTINE CLOUD( & cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 -! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu & -! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd - !*********************************************************************** ST1 = HALF*(HSU + HSD) @@ -1992,8 +1767,6 @@ SUBROUTINE CLOUD( & clp = one st2 = hbl - hsu -! if(lprnt) write(0,*)' tx2=',tx2,' tx1=',tx1,' st2=',st2 -! if (tx2 == zero) then alm = - st2 / tx1 if (alm > almax) alm = -100.0 @@ -2009,14 +1782,9 @@ SUBROUTINE CLOUD( & if (tem2 > almax) tem2 = -100.0 alm = max(tem1,tem2) -! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm & -! &,' tx1=',tx1,' tem=',tem,' epp=',epp,' x00=',x00,' st2=',st2 - endif endif -! if (lprnt) write(0,*)' almF=',alm,' ii=',ii,' qw00=',qw00 & -! &,' qi00=',qi00 ! ! CLIP CASE: ! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. @@ -2045,9 +1813,6 @@ SUBROUTINE CLOUD( & GO TO 888 ENDIF ! -! if (lprnt) write(0,*)' hstkd=',hst(kd),' qstkd=',qst(kd) & -! &,' ii=',ii,' clp=',clp - st1s = ONE IF(CLP > ZERO .AND. CLP < ONE) THEN ST1 = HALF*(ONE+CLP) @@ -2117,7 +1882,6 @@ SUBROUTINE CLOUD( & ENDDO ETAI(KBL) = one -! if (lprnt) write(0,*)' eta=',eta,' ii=',ii,' alm=',alm ! !===> CLOUD WORKFUNCTION ! @@ -2148,12 +1912,6 @@ SUBROUTINE CLOUD( & DETP = (BKC(L)*DET - (QTVP-QTV) & & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) -! if(lprnt) write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & -! if (lprnt .and. kd == 15) -! & write(0,*)' detp=',detp,' bkc=',bkc(l),' det=',det & -! &,' qtvp=',qtvp,' qtv=',qtv,' del_eta=',del_eta,' qol=' & -! &,qol(l),' st1=',st1,' akc=',akc(l) -! TEM1 = AKT(L) - QLL(L) TEM2 = QLL(LP1) - BKC(L) RNS(L) = TEM1*DETP + TEM2*DET - ST1 @@ -2172,37 +1930,16 @@ SUBROUTINE CLOUD( & TEM2 = HCCP + DETP * QTP * ALHF ! -! if(lprnt) write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & -! if (lprnt .and. kd == 15) -! & write(0,*)' hst=',hst(l),' ltl=',ltl(l),' nu=',nu & -! &,' qst=',qst(l),' qol=',qol(l),' hccp=',hccp,' detp=',detp & -! &,' qtp=',qtp,' alhf=',alhf,' vtf=',vtf(l) - ST2 = LTL(L) * VTF(L) TEM5 = CLL(L) + CIL(L) TEM3 = (TX1 - ETA(LP1)*ST1 - ST2*(DET-TEM5*eta(lp1))) * DLB(L) TEM4 = (TEM2 - ETA(L )*ST1 - ST2*(DETP-TEM5*eta(l))) * DLT(L) ! -! if (lprnt) then -! if (lprnt .and. kd == 12) then -! write(0,*)' tem3=',tem3,' tx1=',tx1,' st1=',st1,' eta1=',eta(l+1) & -! &, ' st2=',st2,' det=',det,' tem5=',tem5,' dlb=',dlb(l) & -! write(0,*)' tem4=',tem4,' tem2=',tem2,' detp=',detp & -! &, ' eta=',eta(l),' dlt=',dlt(l),' rns=',rns(l),' l=',l & -! write(0,*)' bt1=',tem3/(eta(l+1)*qrb(l)) & -! &, ' bt2=',tem4/(eta(l)*qrt(l)) -! endif - ST1 = TEM3 + TEM4 -! if (lprnt) write(0,*)' wfn=',wfn,' st1=',st1,' l=',l,' ep_wfn=', & -! &ep_wfn,' akm=',akm - WFN = WFN + ST1 AKM = AKM - min(ST1,ZERO) -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm - if (st1 < zero .and. wfn < zero) then dpneg = dpneg + prl(lp1) - prl(l) endif @@ -2235,9 +1972,6 @@ SUBROUTINE CLOUD( & ! 888 continue -! if (lprnt) write(0,*)' ep_wfn=',ep_wfn,' ii=',ii,' rns=',rns(kd) & -! &,' clp=',clp,' hst(kd)=',hst(kd) - if (ep_wfn) then IF ((qw00 == zero .and. qi00 == zero)) RETURN if (ii == 0) then @@ -2264,9 +1998,6 @@ SUBROUTINE CLOUD( & qw00 = zero qi00 = zero -! if (lprnt) write(0,*)' returning to 777 : ii=',ii,' qw00=',qw00, & -! & qi00,' clp=',clp,' hst(kd)=',hst(kd) - go to 777 else cnvflg = .true. @@ -2282,18 +2013,12 @@ SUBROUTINE CLOUD( & TEM5 = (QLS + QIS) * eta(kd1) ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) ! -! if (lprnt) write(0,*)' st1=',st1,' st2=',st2,' ltl=',ltl(kd) & -! &,ltl(kd1),' qos=',qos,qol(kd1) - WFN = WFN + ST1 AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top ! BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) ! -! if (lprnt) write(0,*)' wfn=',wfn,' akm=',akm,' st1=',st1 & -! &,' dpneg=',dpneg - DET = DETP HCC = HCCP AKM = AKM / WFN @@ -2316,8 +2041,6 @@ SUBROUTINE CLOUD( & IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. -! if (lprnt) write(0,*)' calcup=',calcup,' akm=',akm,' tem=',tem & -! &,' cnvflg=',cnvflg,' clp=',clp,' rhc=',rhc,' cd=',cd,' acr=',acr ! !===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN ! @@ -2332,8 +2055,6 @@ SUBROUTINE CLOUD( & !! CLP = CLP * max(0.0, min(1.0,(0.1 + 0.9*(ALM-ALMIN1)*ST1))) ! ENDIF ! ENDIF -! -! if (lprnt) write(0,*)' clp=',clp ! CLP = CLP * RHC dlq = zero @@ -2345,7 +2066,6 @@ SUBROUTINE CLOUD( & DO L=KBL,K RNN(L) = zero ENDDO -! if (lprnt) write(0,*)' rnn=',rnn ! ! If downdraft is to be invoked, do preliminary check to see ! if enough rain is available and then call DDRFT. @@ -2363,12 +2083,6 @@ SUBROUTINE CLOUD( & IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! -! if (lprnt) then -! write(0,*)' BEFORE CALLING DDRFT KD=',kd,' DDFT=',DDFT -! &, ' PL=',PL,' TRAIN=',TRAIN -! write(0,*)' buy=',(buy(l),l=kd,kb1) -! endif - IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) CALL DDRFT( & & K, KP1, KD & @@ -2378,7 +2092,7 @@ SUBROUTINE CLOUD( & &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & &, ALM, WFN, TRAIN, DDFT & &, ETD, HOD, QOD, EVP, DOF, CLDFR, ETZ & - &, GMS, GSD, GHD, wvl, lprnt) + &, GMS, GSD, GHD, wvl) ENDIF ! @@ -2399,10 +2113,6 @@ SUBROUTINE CLOUD( & ENDIF -! if (lprnt) write(0,*) ' hod=',hod -! if (lprnt) write(0,*) ' etd=',etd -! if (lprnt) write(0,*) ' aft dd wvl=',wvl -! ! !===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX ! Includes downdraft terms! @@ -2430,9 +2140,6 @@ SUBROUTINE CLOUD( & GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) - -! if (lprnt) write(0,*)' gmhkd=',gmh(kd),' gmskd=',gms(kd) -! &,' det=',det,' tem=',tem,' tem1=',tem1,' tem2=',tem2 ! ! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER ! @@ -2473,10 +2180,6 @@ SUBROUTINE CLOUD( & GMH(L) = DH * PRI(L) GMS(L) = DS * PRI(L) -! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) -! &,' hb=',hb,' hol=',hol(l),' l=',l,' hod=',hod(l) -! &,' etd=',etd(l),' qod=',qod(l),' tem5=',tem5,' tem6=',tem6 ! GHD(L) = TEM5 * PRI(L) GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) @@ -2493,21 +2196,12 @@ SUBROUTINE CLOUD( & GMH(LM1) = GMH(LM1) + DH * PRI(LM1) GMS(LM1) = GMS(LM1) + DS * PRI(LM1) -! -! if (lprnt) write(0,*)' gmh1=',gmh(l-1),' gms1=',gms(l-1) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l-1) -! &,' hb=',hb,' hol=',hol(l-1),' evp=',evp(l-1) ! GHD(LM1) = GHD(LM1) - TEM5 * PRI(LM1) GSD(LM1) = GSD(LM1) - (TEM5-ALHL*(TEM6-EVP(LM1))) * PRI(LM1) QIL(LM1) = QIL(LM1) + TEM1 * PRI(LM1) QLL(LM1) = QLL(LM1) + TEM3 * PRI(LM1) - - -! if (lprnt) write(0,*)' gmh=',gmh(l),' gms=',gms(l) -! &,' dh=',dh,' ds=',ds,' qb=',qb,' qol=',qol(l),' eta=',eta(l) -! &,' hb=',hb,' hol=',hol(l),' l=',l ! avh = avh + gmh(lm1)*(prs(l)-prs(lm1)) @@ -2526,8 +2220,6 @@ SUBROUTINE CLOUD( & GHD(K) = GHD(K) + TEM1 GSD(K) = GSD(K) + TEM2 -! if (lprnt) write(0,*)' gmhk=',gmh(k),' gmsk=',gms(k) -! &,' tem1=',tem1,' tem2=',tem2,' dh=',dh,' ds=',ds ! avh = avh + gmh(K)*(prs(KP1)-prs(K)) ! @@ -2544,11 +2236,6 @@ SUBROUTINE CLOUD( & avh = avh + tx1*(prs(l+1)-prs(l)) ENDDO -! -! if (lprnt) then -! write(0,*)' gmh=',gmh -! write(0,*)' gms=',gms(KD:K) -! endif ! !*********************************************************************** !*********************************************************************** @@ -2611,7 +2298,6 @@ SUBROUTINE CLOUD( & ! qbl = qbl * hpert_fac ! endif -! if (lprnt) write(0,*)' hbla=',hbl,' qbla=',qbl !*********************************************************************** @@ -2683,10 +2369,6 @@ SUBROUTINE CLOUD( & ! AMB = - (WFN-ACR) / AKM ! -! if(lprnt) write(0,*)' wfn=',wfn,' acr=',acr,' akm=',akm & -! &,' amb=',amb,' KD=',kd,' cldfrd=',cldfrd & -! &,' rel_fac=',rel_fac,' prskd=',prs(kd),' revap=',revap - !===> RELAXATION AND CLIPPING FACTORS ! AMB = AMB * CLP * rel_fac @@ -2699,7 +2381,6 @@ SUBROUTINE CLOUD( & AMB = MAX(MIN(AMB, AMBMAX),ZERO) -! if(lprnt) write(0,*)' AMB=',amb,' clp=',clp,' ambmax=',ambmax !*********************************************************************** !*************************RESULTS*************************************** !*********************************************************************** @@ -2716,14 +2397,9 @@ SUBROUTINE CLOUD( & if (do_aw) then tx1 = (0.2 / max(alm, 1.0e-5)) tx2 = one - min(one, pi * tx1 * tx1 / area) -! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 & -! &,' area=',area,' pi=',pi,' tx2=',tx2 tx2 = tx2 * tx2 -! if(lprnt) write(0,*)' kd=',kd,' wvl=',wvl(kd:k+1) -! if(lprnt) write(0,*)' kd=',kd,' eta=',eta(kd:k+1) -! if(lprnt) write(0,*)' kd=',kd,' rho=',rho(kd:k) ! comnet out the following for now - 07/23/18 ! do l=kd1,kbl ! lp1 = min(K, l+1) @@ -2744,7 +2420,6 @@ SUBROUTINE CLOUD( & else sigf(kd:k) = one endif -! if(lprnt) write(0,*)' for kd=',kd,'sigf=',sigf(kd:k) ! avt = zero avq = zero @@ -2752,11 +2427,9 @@ SUBROUTINE CLOUD( & ! DSFC = DSFC + AMB * ETD(K) * (one/DT) * sigf(kbl) ! -! DO L=KBL,KD,-1 DO L=K,KD,-1 PCU(L) = PCU(L) + AMB*RNN(L)*sigf(l) ! (A40) avr = avr + rnn(l) * sigf(l) -! if(lprnt) write(0,*)' avr=',avr,' rnn=',rnn(l),' l=',l ENDDO pcu(k) = pcu(k) + amb * dof * sigf(kbl) ! @@ -2795,9 +2468,6 @@ SUBROUTINE CLOUD( & ! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon -! if(lprnt) write(0,*)' avr=',avr,' qll=',qll(l),' l=',l & -! &, ' qil=',qil(l) - ! Correction for negative condensate! if (qii(l) < zero) then tem = qii(l) * elfocp @@ -2836,29 +2506,10 @@ SUBROUTINE CLOUD( & ! endif ! -! -! if (lprnt) then -! write(0,*)' For KD=',KD -! avt = avt * cp * 100.0*86400.0 / (alhl*DT*grav) -! avq = avq * 100.0*86400.0 / (DT*grav) -! avr = avr * 86400.0 / DT -! write(0,*) ' avt=',avt,' avq=',avq,' avr=',avr,' avh=' & -! * ,avh,' alm=',alm,' DDFT=',DDFT,' KD=',KD & -! &,' TOIK-',toi(k),' TOIK-1=',toi(k-1),' TOIK-2=',toi(k-2) -! if (kd == 12 .and. .not. ddft) stop -! if (avh > 0.1 .or. abs(avt+avq) > 1.0e-5 .or. & -! & abs(avt-avr) > 1.0e-5 .or. abs(avr+avq) > 1.0e-5) stop -! -! if (lprnt) then -! write(0,*) ' in CLOUD For KD=',KD -! write(0,*) ' TCU=',(tcu(l),l=kd,k) -! write(0,*) ' QCU=',(Qcu(l),l=kd,k) -! endif ! TX1 = zero TX2 = zero ! -! if (lprnt) write(0,*)' revap=',revap IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN ! tem = zero @@ -2869,27 +2520,10 @@ SUBROUTINE CLOUD( & enddo tem = tem + amb * dof * sigf(kbl) tem = tem * (3600.0/dt) -!!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(area,one))))) -! tem1 = max(1.0, min(100.0,(7.5E10/max(area,one)))) -! tem1 = max(1.0, min(100.0,(5.0E10/max(area,one)))) -! tem1 = max(1.0, min(100.0,(4.0E10/max(area,one)))) -!! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(area,one))))) ! 20100902 tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 -! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=', & -! & tem1 - -! clfrac = max(ZERO, min(ONE, rknob*clf(tem)*tem1)) -! clfrac = max(ZERO, min(0.25, rknob*clf(tem)*tem1)) clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) -! if (lprnt) then -! write(0,*) ' cldfrd=',cldfrd,' amb=',amb,' clfrac=',clfrac -! write(0,*) ' tx3=',tx3,' etakd=',eta(kd),' pri=',pri(kd) -! write(0,*) ' RNN=',RNN(kd:k) -! endif -! -!cnt DO L=KD,K DO L=KD,KBL ! Testing on 20070926 ! for L=KD,K IF (L >= IDH .AND. DDFT) THEN @@ -2911,7 +2545,6 @@ SUBROUTINE CLOUD( & ST2 = ST1*ELFOCP + (one-ST1)*ELOCP CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) -! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) ! DELTAQ = half * (QSTEQ*rhc_ls(l)-QEQ) / (one+ST2*DQDT) ! @@ -2922,7 +2555,6 @@ SUBROUTINE CLOUD( & TEM2 = TEM1*ELFOCP + (one-TEM1)*ELOCP CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) -! CALL QSATCN ( TEQ,PL,QSTEQ,DQDT,.false.) ! DELTAQ = (QSTEQ*rhc_ls(l)-QEQ) / (one+TEM2*DQDT) ! @@ -2935,20 +2567,14 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) -! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX1) ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) -! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, & -! &' clfrac=' & -! &,clfrac,' potevap=',potevap,'efac=',AFC*SQRT(TX1*TEM3) & -! &,' tx1=',tx1 if (tx1 < rainmin*dt) actevap = min(tx1, potevap) ! tem4 = zero if (tx2 > zero) & & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) -! & TEM4 = POTEVAP * (1. - EXP( AFC*tx4*SQRT(TX2) ) ) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2974,10 +2600,6 @@ SUBROUTINE CLOUD( & CUP = CUP + TX1 + DOF * AMB * sigf(kbl) ENDIF -! if (lprnt) write(0,*)' tx1=',tx1,' tx2=',tx2,' dof=',dof & -! &,' cup=',cup*86400/dt,' amb=',amb & -! &,' amb=',amb,' cup=',cup,' clfrac=',clfrac,' cldfrd=',cldfrd & -! &,' ddft=',ddft,' kd=',kd,' kbl=',kbl,' k=',k ! ! Convective transport (mixing) of passive tracers ! @@ -3062,30 +2684,11 @@ SUBROUTINE CLOUD( & st2 = zero endif -! ROI(L,N) = HOL(L) + ST1 -! RCU(L,N) = RCU(L,N) + ST1 - -! if (l < k) then -! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), -! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l -! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) -! &,' roi=',roi(l,n),' n=',n,' prl=',prl(l+1),prl(l),' pri=', -! & pri(l+1) -! else -! if (lprnt .and. n == ntk) write(0,*)' in ras roifin=',roi(l,n), -! &' hol=',hol(l),' gmh=',GMH(L),' amb=',amb,' l=',l -! &,' st2=',st2,' st3=',st3,' trcmin=',trcmin(n) -! &,' roi=',roi(l,n),' n=',n -! endif - ENDDO ENDDO ! Tracer loop NTRC endif endif ! amb > zero -! if (lprnt) write(0,*)' toio=',toi -! if (lprnt) write(0,*)' qoio=',qoi - RETURN end subroutine cloud @@ -3097,7 +2700,7 @@ SUBROUTINE DDRFT( & &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & &, ALM, WFN, TRAIN, DDFT & &, ETD, HOD, QOD, EVP, DOF, CLDFRD, WCB & - &, GMS, GSD, GHD, wvlu, lprnt) + &, GMS, GSD, GHD, wvlu) ! !*********************************************************************** @@ -3172,7 +2775,6 @@ SUBROUTINE DDRFT( & parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! - real (kind=kind_phys), parameter :: PIINV=one/PI ! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi ! parameter (ONPG=one+half, GMF=one/ONPG, RPART=zero) @@ -3200,11 +2802,10 @@ SUBROUTINE DDRFT( & real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & &, VT(2), VRW(2), TRW(2), QA(3), WA(3) - LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK, lprnt + LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK !*********************************************************************** -! if(lprnt) write(0,*)' K=',K,' KD=',KD,' In Downdrft' KD1 = KD + 1 KM1 = K - 1 @@ -3342,10 +2943,6 @@ SUBROUTINE DDRFT( & tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle CTL2 = one - STLA * STLA ! cosine square of tilting angle -! -! if (lprnt) write(0,*)' tla=',tla,' al2=',al2,' ptop=' & -! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla & -! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! STLA = F2 * STLA * AL2 CTL2 = DD1 * CTL2 @@ -3383,7 +2980,6 @@ SUBROUTINE DDRFT( & ST1 = WCB(L) + QW(L,L)*QRP(L) + TX1*GSD(L) ! if (st1 > wc2min) then if (st1 > zero) then -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wvl=',wvl(l) WVL(L) = max(ddunc1*SQRT(ST1) + ddunc2*WVL(L), wcmin) ! WVL(L) = SQRT(ST1) ! WVL(L) = max(half * (SQRT(ST1) + WVL(L)), wcmin) @@ -3391,10 +2987,6 @@ SUBROUTINE DDRFT( & ! & + qrp(l)) else -! if (lprnt) write(0,*)' l=',l,' st1=',st1,' wcb=',wcb(l),' qw='& -! &,qw(l,l),' qrp=',qrp(l),' tx1=',tx1,' gsd=',gsd(l),' itr=',itr & -! &,' wvl=',wvl(l) - ! wvl(l) = 0.5*(wcmin+wvl(l)) ! wvl(l) = max(half*(wvl(l) + wvl(l+1)), wcmin) wvl(l) = max(wvl(l),wcmin) @@ -3408,14 +3000,6 @@ SUBROUTINE DDRFT( & QRPI(L) = one / QRP(L) ENDDO ! -! if (lprnt) then -! write(0,*) ' ITR=',ITR,' ITRMU=',ITRMU,' kd=',kd,' kbl=',kbl -! write(0,*) ' WVL=',(WVL(L),L=KD,KBL) -! write(0,*) ' qrp=',(qrp(L),L=KD,KBL) -! write(0,*) ' qrpi=',(qrpi(L),L=KD,KBL) -! write(0,*) ' rnf=',(rnf(L),L=KD,KBL) -! endif -! !-----CALCULATING TRW, VRW AND OF ! ! VT(1) = GMS(KD) * QRP(KD)**0.1364 @@ -3652,8 +3236,6 @@ SUBROUTINE DDRFT( & KK1 = KK + 1 AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! -! if (lprnt) write(0,*) ' tx2a=',tx2,' aa1=',aa(kk,kk1) & -! &,' qrpi=',qrpi(kk) ! KK = KBL + 1 DO L=KB1,KD,-1 @@ -3664,10 +3246,6 @@ SUBROUTINE DDRFT( & ENDDO AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! - -! if (lprnt) write(0,*)' tx2b=',tx2,' aa1=',aa(l,kk) & -! &,' qrpi=',qrpi(l),' L=',L - ENDDO ! ! tem = 0.5 @@ -3684,8 +3262,6 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(QRP(L)+AA(L,KBL+1)*tem, QRMIN) ENDDO ! -! if (lprnt) write(0,*)' itr=',itr,' tx2=',tx2 - IF (ITR < ITRMIN) THEN TEM = ABS(ERRQ-TX2) IF (TEM >= ERRMI2 .AND. TX2 >= ERRMIN) THEN @@ -3693,8 +3269,6 @@ SUBROUTINE DDRFT( & ELSE SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here1',' tem=',tem,' tx2=',tx2,' errmi2=', & -! &errmi2,' errmin=',errmin ENDIF ELSE TEM = ERRQ - TX2 @@ -3702,14 +3276,12 @@ SUBROUTINE DDRFT( & IF (TEM < ZERO .AND. ERRQ > 0.5) THEN ! IF (TEM < ZERO .and. & ! & (ntla < numtla .or. ERRQ > 0.5)) THEN -! if (lprnt) write(0,*)' tx2=',tx2,' errq=',errq,' tem=',tem SKPUP = .TRUE. ! No convergence ! ERRQ = 10.0 ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! -! if (lprnt) write(0,*)' here2' elseif (tem < zero .and. errq < 0.1) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then @@ -3719,23 +3291,14 @@ SUBROUTINE DDRFT( & ! endif ELSE ERRQ = TX2 ! Further iteration ! -! if (lprnt) write(0,*)' itr=',itr,' errq=',errq ! if (itr == itrmu .and. ERRQ > ERRMIN*10 & ! & .and. ntla == 1) ERRQ = 10.0 ENDIF ENDIF ! -! if (lprnt) write(0,*)' ERRQ=',ERRQ - ENDIF ! SKPUP ENDIF! ! ENDDO ! End of the ITR Loop!! -! -! if(lprnt) then -! write(0,*)' QRP=',(QRP(L),L=KD,KBL) -! write(0,*)'RNF=',(RNF(L),L=KD,KBL),' RNT=',RNT,' RNB=',RNB & -! &,' errq=',errq -! endif ! IF (ERRQ < 0.1) THEN DDFT = .TRUE. @@ -3757,9 +3320,7 @@ SUBROUTINE DDRFT( & DO L=KD,KB1 TX1 = TX1 + RNF(L) ENDDO -! if (lprnt) write(0,*)' tx1+rnt+rnb=',tx1+rnt+rnb, ' train=',train TX1 = TRAIN / (TX1+RNT+RNB) -! if (lprnt) write(0,*)' tx1= ', tx1 IF (ABS(TX1-one) < 0.2) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 @@ -3768,9 +3329,6 @@ SUBROUTINE DDRFT( & ENDDO ! rain flux adjustment is over -! if (lprnt) write(0,*)' TRAIN=',TRAIN -! if (lprnt) write(0,*)' RNF=',RNF - ELSE DDFT = .FALSE. ERRQ = 10.0 @@ -3789,7 +3347,6 @@ SUBROUTINE DDRFT( & wvlu(kd:kp1) = wvl(kd:kp1) ! save updraft vertical velocity for output -! if (lprnt) write(0,*)' in ddrft kd=',kd,'wvlu=',wvlu(kd:kp1) ! ! Downdraft calculation begins ! ---------------------------- @@ -3814,7 +3371,6 @@ SUBROUTINE DDRFT( & STLT(L) = zero ENDIF ENDDO -! if (lprnt) write(0,*)' STLT=',stlt rsum1 = zero rsum2 = zero @@ -3839,9 +3395,6 @@ SUBROUTINE DDRFT( & RNTP = zero TX5 = TX1 QA(1) = zero -! if(lprnt) write(0,*)' stlt=',stlt(kd),' qrb=',qrb(kd) & -! &,' tx1=',tx1,' ror=',ror(kd),' gms=',gms(kd),' rpart=',rpart & -! &,' rnt=',rnt ! ! Here we assume RPART of detrained rain RNT goes to Pd ! @@ -3899,9 +3452,6 @@ SUBROUTINE DDRFT( & ! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) -! if(lprnt) write(0,*)' l=',l,' qa=',qa(1), ' tx1RNT=',RNT*tx1,& -! &' wvl=',wvl(l-1) & -! &,' qrp=',qrp(l-1),' tx5=',tx5,' tx1=',tx1,' rnt=',rnt ! @@ -3979,8 +3529,6 @@ SUBROUTINE DDRFT( & ! ! Iteration loop for a given level L begins ! -! if (lprnt) write(0,*)' tx8=',tx8,' tx9=',tx9,' tx5=',tx5 & -! &, ' tx1=',tx1 else DO ITR=1,ITRMD ! @@ -4002,9 +3550,6 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! if (lprnt) write(0,*)' st1=',st1,' tem=',tem,' ror=',ror(l) & -! &,' qrp=',qrp(l),' rnt=',rnt,' ror1=',ror(l-1),' wvl=',wvl(l) & -! &,' wvl1=',wvl(l-1),' tem2=',tem2,' vt=',vt(1),' tx3=',tx3 ! st2 = tx5 TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) @@ -4023,17 +3568,6 @@ SUBROUTINE DDRFT( & ! else ! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) ! endif -! -! if(lprnt) write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & -! if(tx5 <= 0.0 .and. l > kd+2) & -! & write(0,*)' tx51=',tx5,' tx1=',tx1,' st1=',st1,' tem2=' & -! &,tem2,' tx3=',tx3,' tem=',tem,' tem1=',tem1,' wvl=',wvl(l-1), & -! &wvl(l),' l=',l,' itr=',itr,' evp=',evp(l-1),' vt=',vt(1) & -! &,' qrp=',qrp(l),' rnt=',rnt,' kd=',kd -! if (lprnt) write(0,*)' etd=',etd(l),' wvl=',wvl(l) & -! &,' trw=',trw(1),trw(2),' ror=',ror(l),' wa=',wa - - ! TEM1 = ETD(L) ETD(L) = ROR(L) * TX5 * MAX(WVL(L),ZERO) @@ -4077,8 +3611,6 @@ SUBROUTINE DDRFT( & ENDIF ERRH = HOD(L) - TEM1 ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) -! if (lprnt) write(0,*)' ERRQP=',errq,' errh=',errh,' hod=',hod(l) & -! &,' erre=',erre,' etd=',etd(l),' del_eta=',del_eta DOF = DDZ VT(2) = QQQ ! @@ -4120,9 +3652,6 @@ SUBROUTINE DDRFT( & EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) ! Calculate Pd (L+1/2) QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) -! -! if(lprnt) write(0,*)' etd=',etd(l),' tx5=',tx5,' rnt=',rnt & -! &,' rnf=',rnf(l-1),' evp=',evp(l-1),' itr=',itr,' L=',L ! if (qa(1) > zero) then IF (ETD(L) > zero) THEN @@ -4140,9 +3669,6 @@ SUBROUTINE DDRFT( & ! Compute Buoyancy TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & & * onebcp -! if (lprnt) write(0,*)' tem1=',tem1,' wa3=',wa(3),' hod=' & -! &,hod(l),' wa1=',wa(1),' qod=',qod(l),' wa2=',wa(2),' alhl=',alhl & -! &,' cmpor=',cmpor,' dofw=',dofw,' prl=',prl(l),' qrp=',qrp(l) TEM1 = TEM1 * (one + NU*QOD(L)) ROR(L) = CMPOR * PRL(L) / TEM1 TEM1 = TEM1 * DOFW @@ -4152,14 +3678,8 @@ SUBROUTINE DDRFT( & ! Compute W (L+1/2) TEM1 = WVL(L) -! IF (ETD(L) > 0.0) THEN WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) -! -! if (lprnt) write(0,*)' wvl=',wvl(l),'vt2=',vt(2),' buy1=' & -! &,buy(l-1),' buy=',buy(l),' qrt1=',qrt(l-1),' qrb1=',qrb(l-1) & -! &,' etd1=',etd(l-1),' wvl1=',wvl(l-1) -! ENDIF ! if (wvl(l) < zero) then ! WVL(L) = max(wvl(l), 0.1*tem1) @@ -4178,20 +3698,9 @@ SUBROUTINE DDRFT( & ! ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) -! if (lprnt) write(0,*)' errw=',errw,' wvl=',wvl(l) -! if(lprnt .or. tx5 == 0.0) then -! if(tx5 == 0.0 .and. l > kbl) then -! write(0,*)' errq=',errq,' itr=',itr,' l=',l,' wvl=',wvl(l) & -! &,' tx5=',tx5,' idnm=',idnm,' etd1=',etd(l-1),' etd=',etd(l) & -! &,' kbl=',kbl -! endif -! -! if(lprnt) write(0,*)' itr=',itr,' itrmnd=',itrmnd,' itrmd=',itrmd ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN -! if(lprnt) write(0,*)' itr=',itr,' etd1=',etd(l-1),' errq=',errq IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN -! if(lprnt) write(0,*)' bud=',bud(kd),' wa=',wa(1),wa(2) ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -4206,24 +3715,11 @@ SUBROUTINE DDRFT( & & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) endif -! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) & -! &,' evp=',evp(l-1),' l=',l - EVP(L-1) = zero TEM = MAX(TX1*RNT+RNF(L-1),ZERO) QA(1) = TEM - EVP(L-1) ! IF (QA(1) > 0.0) THEN -! if(lprnt) write(0,*)' ror=',ror(l),' tx5=',tx5,' tx1=',tx1 & -! &,' tx9=',tx9,' gms=',gms(l),' qa=',qa(1) -! if(lprnt) call mpi_quit(13) -! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) & -! & write(0,*)' Atx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! &,' kbl=',kbl,' etd1=',etd(l-1),' idnm=',idnm,' idn=',idn(idnm) & -! &,' errq=',errq - QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & & ** (one/1.1364) ! endif @@ -4294,13 +3790,6 @@ SUBROUTINE DDRFT( & QA(1) = QA(1) - EVP(L-1) qrp(l) = zero -! -! if (tx5 == 0.0 .or. gms(l) == 0.0) -! if (lprnt) & -! & write(0,*)' Btx5=',tx5,' gms=',gms(l),' ror=',ror(l) & -! &,' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & -! &,' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA & -! &,' evp=',evp(l-1) ! ! IF (QA(1) > 0.0) THEN !! RNS(L-1) = QA(1) @@ -4381,12 +3870,6 @@ SUBROUTINE DDRFT( & endif ENDIF -! if (lprnt) then -! write(0,*)' ERRQ=',ERRQ,' IDN=',IDN(idnm),' idnm=',idnm -! write(0,*)' L=',L,' QRP=',QRP(L),' ETD=',ETD(L),' QA=',QA(1) & -! &, ' evp=',evp(l-1),' rnf=',rnf(l-1) -! endif - ! ! If downdraft properties are not obtainable, (i.e.solution does ! not converge) , no downdraft is assumed @@ -4422,7 +3905,6 @@ SUBROUTINE DDRFT( & TX1 = EVP(KD) TX2 = RNTP + RNB + DOF -! if (lprnt) write(0,*)' tx2=',tx2 II = IDH IF (II >= KD1+1) THEN RNN(KD) = RNN(KD) + RNF(KD) @@ -4430,7 +3912,6 @@ SUBROUTINE DDRFT( & RNN(II-1) = zero TX1 = EVP(II-1) ENDIF -! if (lprnt) write(0,*)' tx2=',tx2,' idnm=',idnm,' idn=',idn(idnm) DO L=KD,K II = IDH @@ -4449,7 +3930,6 @@ SUBROUTINE DDRFT( & RNN(L) = RNF(L) + RNS(L) TX2 = TX2 + RNN(L) ENDIF -! if (lprnt) write(0,*)' tx2=',tx2,' L=',L,' rnn=',rnn(l) ENDDO ! ! For Downdraft case the rain is that falls thru the bottom @@ -4464,8 +3944,6 @@ SUBROUTINE DDRFT( & ! conservation of precip! ! -! if (lprnt) write(0,*)' train=',train,' tx2=',tx2,' tx1=',tx1 - IF (TX1 > zero) THEN TX1 = (TRAIN - TX2) / TX1 ELSE @@ -4485,7 +3963,6 @@ SUBROUTINE DDRFT( & end subroutine ddrft SUBROUTINE QSATCN(TT,P,Q,DQDT) -! SUBROUTINE QSATCN(TT,P,Q,DQDT,lprnt) ! USE FUNCPHYS , ONLY : fpvs @@ -4493,12 +3970,11 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) ! real(kind=kind_phys) TT, P, Q, DQDT ! - real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & - &, rvi=one/rv, facw=CVAP-CLIQ & - &, faci=CVAP-CSOL, hsub=alhl+alhf & - &, tmix=TTP-20.0 & - &, DEN=one/(TTP-TMIX) -! logical lprnt +! real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & +! &, rvi=one/rv, facw=CVAP-CLIQ & +! &, faci=CVAP-CSOL, hsub=alhl+alhf & +! &, tmix=TTP-20.0 & +! &, DEN=one/(TTP-TMIX) ! real(kind=kind_phys) es, d, hlorv, W ! @@ -4508,9 +3984,6 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) D = one / (p+epsm1*es) ! q = MIN(eps*es*D, ONE) - -! if (lprnt) write(0,*)' q=',q,' eps=',eps,' es=',es,' d=',d, & -! &' one=',one,' tt=',tt,' p=',p,' epsm1=',epsm1,' fpvs=',fpvs(tt) ! W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) hlorv = ( W * (alhl + FACW * (tt-ttp)) & @@ -4521,7 +3994,6 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) end subroutine qsatcn SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) -! use module_ras , only : refp, refr, tlac, plac, tlbpl, drdp implicit none real(kind=kind_phys) PRES, ALM, AL2, TLA, TEM @@ -4572,7 +4044,6 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) end subroutine angrad SUBROUTINE SETQRP -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB,one implicit none real(kind=kind_phys) tem2,tem1,x,xinc,xmax,xmin @@ -4597,7 +4068,6 @@ SUBROUTINE SETQRP end subroutine setqrp SUBROUTINE QRABF(QRP,QRAF,QRBF) -! use module_ras , only : NQRP,C1XQRP,C2XQRP,TBQRP,TBQRA,TBQRB, one implicit none ! real(kind=kind_phys) QRP, QRAF, QRBF, XJ, REAL_NQRP @@ -4614,7 +4084,6 @@ SUBROUTINE QRABF(QRP,QRAF,QRBF) end subroutine qrabf SUBROUTINE SETVTP -! use module_ras , only : NVTP,C1XVTP,C2XVTP,TBVTP implicit none real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 7201888bc..0a201e74d 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -18,6 +18,132 @@ kind = kind_phys intent = in optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -241,22 +367,6 @@ type = integer intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration