From 38a495eef031c23cecb4cc72e84f1510bae9a7ea Mon Sep 17 00:00:00 2001 From: SMoorthi-emc <47667426+SMoorthi-emc@users.noreply.github.com> Date: Fri, 6 Mar 2020 11:54:49 -0500 Subject: [PATCH] Sm jan102020 (#44) * github version of latest branch * some fixes to physics driver * adding import field of z0 surface roughness length and cplwav2atm flag for coupling wave to atm * removing 271.2 near line 1884 * minor update of atmos_model.F90 * updating GFS_typedef for includeing ras in ccpp, plus minor mod in physics driver * after merging with Jessica's wave update in fv3 * coupling with ww3 * after merging with fv3atm develop branch and updating for ras * FV3 updates for RAS MG3 SHOC so that IPD and CCPP reproduce in REPRO mode * updating mg driver, physics driver and typedef * updating gcm_shoc.f90 to turn on commented code in assumed pdf * constraing imported ice fraction in atmos_model.F90 * after merging with NOAA-EMC/fv3atm/develop * minor fix to atmos_model.F90 and IPD physics driver * updating .gitmodules * adding two couplrd suites * a bug fix in atmos_model.F90, added a logical frac_grid_off to enable reading fractional grid orography file and run as no fractional grid, and minor bug fix in physics driver related to the fractional grid - FV3GFS_io.F90 is modified to use lake fraction if it exists to distinguish lake from ocean * adding con_csol to GFS_typedefs.F90 and GFS_typedefs.meta for CCPP * Update long names of hydrometeors to match the ccpp-physics change * reverting white space changes in .gitmodules * adding ignore_lake flag to GFS_typedefs.F90 andFV3GFS_io.F90 to preserve the option used in current s2s benchmarks * settng the momentum, sensible and latent heat fluxes over land exported to the mediator set to large values and over 100% sea ice set to values imported from icemodel. The mask identifying the ocean points to the mediator is correted based on ocean fraction. Updates also include name changes for the ice fields as changed by Denise Worthen. Also added an ignore_lake option to the namelist * changing variable puny to epsln in atmos_model.F90 on Denise's recommendation * added a new namelist parameter, min_lake_height, with default value of 250m, changeable by user to give more generality * update gcycle * point atmos_cubed_sphere to NOAA-EMC repo and ccpp/physics to SMoorthi-EMC SM_Jan102020 branch * reverting definition of do_cnvgwd in GFS_typedefs.F90 * removed 3 lines from gcycle.F90, which I previously forgot to delete * fixing a bug in gcycle update * removing updating tsfco in gcycle when nsstr is on * updating .gitmodules to point to NCAR/ccpp-physics master branch Co-authored-by: Jessica.Meixner Co-authored-by: Dom Heinzeller Co-authored-by: Jun.Wang --- atmos_model.F90 | 89 ++- ccpp/config/ccpp_prebuild_config.py | 1 + ccpp/physics | 2 +- ccpp/suites/suite_FV3_CPT_v0.xml | 1 - ccpp/suites/suite_FV3_GFS_2017.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_coupled.xml | 3 +- ccpp/suites/suite_FV3_GFS_2017_csawmg.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml | 1 - .../suite_FV3_GFS_2017_gfdlmp_noahmp.xml | 1 - .../suite_FV3_GFS_2017_gfdlmp_regional.xml | 1 - ...uite_FV3_GFS_2017_gfdlmp_regional_c768.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_myj.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml | 1 - .../suites/suite_FV3_GFS_2017_ozphys_2015.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_sas.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_shinhong.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_stretched.xml | 1 - ccpp/suites/suite_FV3_GFS_2017_ysu.xml | 1 - ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml | 88 +++ .../suite_FV3_GFS_cpldnst_rasmgshoc.xml | 90 ++++ ccpp/suites/suite_FV3_GFS_rasmgshoc.xml | 92 ++++ ccpp/suites/suite_FV3_GFS_v15.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_gf.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_mynn.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_ras.xml | 94 ++++ ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml | 89 +++ ccpp/suites/suite_FV3_GFS_v15_thompson.xml | 1 - .../suite_FV3_GFS_v15_thompson_mynn.xml | 1 - ccpp/suites/suite_FV3_GFS_v15p2.xml | 1 - ccpp/suites/suite_FV3_GFS_v15plus.xml | 1 - ccpp/suites/suite_FV3_GFS_v15plusras.xml | 94 ++++ ccpp/suites/suite_FV3_GFS_v16beta.xml | 1 - ccpp/suites/suite_FV3_GSD_SAR.xml | 1 - ccpp/suites/suite_FV3_GSD_noah.xml | 1 - ccpp/suites/suite_FV3_GSD_v0.xml | 1 - ccpp/suites/suite_FV3_GSD_v0_drag_suite.xml | 1 - .../suite_FV3_HAFS_ferhires_update_moist.xml | 1 - cpl/module_cap_cpl.F90 | 2 +- cpl/module_cplfields.F90 | 13 +- fv3_cap.F90 | 12 +- gfsphysics/GFS_layer/GFS_driver.F90 | 6 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 506 ++++++++++-------- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 16 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 162 +++--- gfsphysics/GFS_layer/GFS_typedefs.meta | 96 +++- gfsphysics/physics/cires_ugwp_initialize.F90 | 20 +- gfsphysics/physics/cires_ugwp_triggers.F90 | 52 +- gfsphysics/physics/dcyc2.f | 2 +- gfsphysics/physics/gcm_shoc.f90 | 195 ++++--- gfsphysics/physics/gcycle.F90 | 17 +- gfsphysics/physics/gwdps.f | 20 +- gfsphysics/physics/m_micro_driver.F90 | 37 +- gfsphysics/physics/micro_mg2_0.F90 | 94 ++-- gfsphysics/physics/micro_mg3_0.F90 | 25 +- gfsphysics/physics/micro_mg_utils.F90 | 247 +++++---- gfsphysics/physics/moninshoc.f | 16 +- gfsphysics/physics/rascnvv2.f | 61 ++- gfsphysics/physics/sfc_diff.f | 44 +- gfsphysics/physics/sfc_nst.f | 4 +- gfsphysics/physics/sfc_sice.f | 2 +- gfsphysics/physics/ugwp_driver_v0.f | 328 ++++++------ io/FV3GFS_io.F90 | 17 +- module_fcst_grid_comp.F90 | 16 +- namphysics/NAM_layer/NAM_typedefs.F90 | 17 +- 69 files changed, 1759 insertions(+), 942 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml create mode 100644 ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml create mode 100644 ccpp/suites/suite_FV3_GFS_rasmgshoc.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v15_ras.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v15plusras.xml diff --git a/atmos_model.F90 b/atmos_model.F90 index ea336a100..a0204da0a 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -223,7 +223,8 @@ module atmos_model_mod #endif real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, & - one = 1.0_IPD_kind_phys + one = 1.0_IPD_kind_phys, & + epsln = 1.0e-10_IPD_kind_phys contains @@ -1596,6 +1597,7 @@ subroutine assign_importdata(rc) real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 + real(kind=IPD_kind_phys) :: tem logical found, isFieldCreated, lcpl_fice ! !------------------------------------------------------------------------------ @@ -1663,6 +1665,29 @@ subroutine assign_importdata(rc) ! endif ! endif + +! get sea-state dependent surface roughness (if cplwav2atm=true) +!---------------------------- + fldname = 'wave_z0_roughness_length' + if (trim(impfield_name) == trim(fldname)) then + findex = QueryFieldList(ImportFieldsList,fldname) + if (importFieldsValid(findex) .and. IPD_control%cplwav2atm) then +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then + tem = 100.0 * max(zero, min(0.1, datar8(i,j))) + IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem + IPD_Data(nb)%Sfcprop%zorlo(ix) = tem + + endif + enddo + enddo + endif + endif + ! get sea ice surface temperature !-------------------------------- fldname = 'sea_ice_surface_temperature' @@ -1674,7 +1699,9 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) + if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then + IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) + endif enddo enddo endif @@ -1718,19 +1745,16 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = IPD_Data(nb)%Sfcprop%slmsk(ix) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then if (datar8(i,j) >= IPD_control%min_seaice*IPD_Data(nb)%Sfcprop%oceanfrac(ix)) then IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(datar8(i,j),one)) -! if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) == one) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4. - else - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) == one) IPD_Data(nb)%Sfcprop%slmsk(ix) = zero + elseif (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then + IPD_Data(nb)%Sfcprop%slmsk(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero endif - else - IPD_Data(nb)%Sfcprop%slmsk(ix) = one - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = one endif enddo enddo @@ -1906,6 +1930,7 @@ subroutine assign_importdata(rc) IPD_Data(nb)%Sfcprop%hice(ix) = IPD_Data(nb)%Coupling%hicein_cpl(ix) IPD_Data(nb)%Sfcprop%snowd(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) else + IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) IPD_Data(nb)%Sfcprop%fice(ix) = zero IPD_Data(nb)%Sfcprop%hice(ix) = zero IPD_Data(nb)%Sfcprop%snowd(ix) = zero @@ -1916,12 +1941,30 @@ subroutine assign_importdata(rc) IPD_Data(nb)%Coupling%dvsfcin_cpl(ix) = -99999.0 ! ,, IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! ,, IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = -99999.0 ! ,, - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) == one) IPD_Data(nb)%Sfcprop%slmsk(ix) = zero ! 100% open water + if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) & + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero ! 100% open water endif endif enddo enddo endif +! +!------------------------------------------------------------------------------- +! do j=jsc,jec +! do i=isc,iec +! nb = Atm_block%blkno(i,j) +! ix = Atm_block%ixp(i,j) +! if (abs(IPD_Data(nb)%Grid%xlon_d(ix)-2.89) < 0.1 .and. & +! abs(IPD_Data(nb)%Grid%xlat_d(ix)+58.99) < 0.1) then +! write(0,*)' in assign tisfc=',IPD_Data(nb)%Sfcprop%tisfc(ix), & +! ' oceanfrac=',IPD_Data(nb)%Sfcprop%oceanfrac(ix),' i=',i,' j=',j,& +! ' tisfcin=',IPD_Data(nb)%Coupling%tisfcin_cpl(ix), & +! ' fice=',IPD_Data(nb)%Sfcprop%fice(ix) +! endif +! enddo +! enddo +!------------------------------------------------------------------------------- +! rc=0 ! @@ -2518,7 +2561,7 @@ subroutine setup_exportdata (rc) exportData(i,j,idx) = DYCORE_Data(nb)%coupling%t_bot(ix) else exportData(i,j,idx) = zero - endif + endif enddo enddo endif @@ -2536,7 +2579,7 @@ subroutine setup_exportdata (rc) exportData(i,j,idx) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) else exportData(i,j,idx) = zero - endif + endif enddo enddo endif @@ -2587,7 +2630,7 @@ subroutine setup_exportdata (rc) exportData(i,j,idx) = DYCORE_Data(nb)%coupling%p_bot(ix) else exportData(i,j,idx) = zero - endif + endif enddo enddo endif @@ -2603,8 +2646,8 @@ subroutine setup_exportdata (rc) if (associated(DYCORE_Data(nb)%coupling%z_bot)) then exportData(i,j,idx) = DYCORE_Data(nb)%coupling%z_bot(ix) else - exportData(i,j,idx) = zero - endif + exportData(i,j,idx) = zero + endif enddo enddo endif @@ -2623,14 +2666,14 @@ subroutine setup_exportdata (rc) enddo enddo endif - endif !cplflx + endif !cplflx !--- ! Fill the export Fields for ESMF/NUOPC style coupling call fillExportFields(exportData) !--- - if (IPD_Control%cplflx) then + if (IPD_Control%cplflx) then ! zero out accumulated fields !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -2663,12 +2706,12 @@ subroutine setup_exportdata (rc) end subroutine setup_exportdata - subroutine addLsmask2grid(fcstgrid, rc) + subroutine addLsmask2grid(fcstGrid, rc) use ESMF ! implicit none - type(ESMF_Grid) :: fcstgrid + type(ESMF_Grid) :: fcstGrid integer, optional, intent(out) :: rc ! ! local vars @@ -2676,7 +2719,7 @@ subroutine addLsmask2grid(fcstgrid, rc) integer i, j, nb, ix ! integer CLbnd(2), CUbnd(2), CCount(2), TLbnd(2), TUbnd(2), TCount(2) type(ESMF_StaggerLoc) :: staggerloc - integer, allocatable :: lsmask(:,:) + integer, allocatable :: lsmask(:,:) integer(kind=ESMF_KIND_I4), pointer :: maskPtr(:,:) ! isc = IPD_control%isc @@ -2691,16 +2734,16 @@ subroutine addLsmask2grid(fcstgrid, rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) ! use land sea mask: land:1, ocean:0 - lsmask(i,j) = floor(IPD_Data(nb)%SfcProp%landfrac(ix)) + lsmask(i,j) = floor(one + epsln - IPD_Data(nb)%SfcProp%oceanfrac(ix)) enddo enddo ! ! Get mask - call ESMF_GridAddItem(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & + call ESMF_GridAddItem(fcstGrid, itemflag=ESMF_GRIDITEM_MASK, & staggerloc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! call ESMF_GridGetItemBounds(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & +! call ESMF_GridGetItemBounds(fcstGrid, itemflag=ESMF_GRIDITEM_MASK, & ! staggerloc=ESMF_STAGGERLOC_CENTER, computationalLBound=ClBnd, & ! computationalUBound=CUbnd, computationalCount=Ccount, & ! totalLBound=TLbnd, totalUBound=TUbnd, totalCount=Tcount, rc=rc) @@ -2709,7 +2752,7 @@ subroutine addLsmask2grid(fcstgrid, rc) ! 'TlBnd=',TlBnd,'TUbnd=',TUbnd,'Tcount=',Tcount ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetItem(fcstgrid, itemflag=ESMF_GRIDITEM_MASK, & + call ESMF_GridGetItem(fcstGrid, itemflag=ESMF_GRIDITEM_MASK, & staggerloc=ESMF_STAGGERLOC_CENTER,farrayPtr=maskPtr, rc=rc) ! print *,'in set up grid, aft get maskptr, rc=',rc, 'size=',size(maskPtr,1),size(maskPtr,2), & ! 'bound(maskPtr)=', LBOUND(maskPtr,1),LBOUND(maskPtr,2),UBOUND(maskPtr,1),UBOUND(maskPtr,2) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index 54b49d726..7dd999750 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -219,6 +219,7 @@ 'FV3/ccpp/physics/physics/precpd.f' : [ 'slow_physics' ], 'FV3/ccpp/physics/physics/radlw_main.f' : [ 'slow_physics' ], 'FV3/ccpp/physics/physics/radsw_main.f' : [ 'slow_physics' ], + 'FV3/ccpp/physics/physics/rascnv.F90' : [ 'slow_physics' ], 'FV3/ccpp/physics/physics/rayleigh_damp.f' : [ 'slow_physics' ], 'FV3/ccpp/physics/physics/rrtmg_lw_post.F90' : [ 'slow_physics' ], 'FV3/ccpp/physics/physics/rrtmg_lw_pre.F90' : [ 'slow_physics' ], diff --git a/ccpp/physics b/ccpp/physics index 01ed01fb0..e7909b4f3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 01ed01fb0b3112e96eb619e0339d88fb0201982f +Subproject commit e7909b4f34336742cab7d4ee687ae467f8fd646c diff --git a/ccpp/suites/suite_FV3_CPT_v0.xml b/ccpp/suites/suite_FV3_CPT_v0.xml index 8eed8e78c..1e8238c33 100644 --- a/ccpp/suites/suite_FV3_CPT_v0.xml +++ b/ccpp/suites/suite_FV3_CPT_v0.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017.xml b/ccpp/suites/suite_FV3_GFS_2017.xml index fc1739bd5..748bd4fed 100644 --- a/ccpp/suites/suite_FV3_GFS_2017.xml +++ b/ccpp/suites/suite_FV3_GFS_2017.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml b/ccpp/suites/suite_FV3_GFS_2017_coupled.xml index d67ce3116..4dc7e3851 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_coupled.xml @@ -48,7 +48,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post @@ -58,7 +57,7 @@ GFS_GWD_generic_pre cires_ugwp cires_ugwp_post - GFS_GWD_generic_post + GFS_GWD_generic_post rayleigh_damp GFS_suite_stateout_update ozphys diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml b/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml index fec7f373e..7babf0411 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_csawmg.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml b/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml index 9fc0b6dae..481ad75f4 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_csawmgshoc.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml index 35fdd9143..8265da4ec 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml index 55dedad57..6113376c2 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_noahmp.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml index 20f91469f..312996ab5 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml index 2e208f6e7..b2e1e019d 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_gfdlmp_regional_c768.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml b/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml index 3e6acbc98..f24f718f8 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_h2ophys.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_myj.xml b/ccpp/suites/suite_FV3_GFS_2017_myj.xml index 7a193a10b..d6bdab7e1 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_myj.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_myj.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml b/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml index 0331483c6..dee198d31 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ntiedtke.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml b/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml index 4e382886c..85671a068 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ozphys_2015.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_sas.xml b/ccpp/suites/suite_FV3_GFS_2017_sas.xml index 1c52ac2cd..059eec012 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_sas.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_sas.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml index af93678ac..5e0094a3e 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_satmedmf.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml index a975c9235..1698e9820 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_satmedmfq.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml b/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml index 756695e65..44aedfcab 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_shinhong.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_stretched.xml b/ccpp/suites/suite_FV3_GFS_2017_stretched.xml index 6bef91b06..999028e00 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_stretched.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_stretched.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_2017_ysu.xml b/ccpp/suites/suite_FV3_GFS_2017_ysu.xml index baeb11c22..3f9947380 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_ysu.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_ysu.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml new file mode 100644 index 000000000..ae5f11931 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml @@ -0,0 +1,88 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + lsm_noah + sfc_ocean + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + moninshoc + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + shoc + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + m_micro_pre + m_micro + m_micro_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml new file mode 100644 index 000000000..bae10c10d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml @@ -0,0 +1,90 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + moninshoc + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + shoc + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + m_micro_pre + m_micro + m_micro_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml new file mode 100644 index 000000000..b914b6461 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml @@ -0,0 +1,92 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + moninshoc + GFS_PBL_generic_post + GFS_GWD_generic_pre + gwdps + gwdps_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + shoc + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + gwdc_pre + gwdc + gwdc_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + m_micro_pre + m_micro + m_micro_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v15.xml b/ccpp/suites/suite_FV3_GFS_v15.xml index efd5fc97b..adf1a69e5 100644 --- a/ccpp/suites/suite_FV3_GFS_v15.xml +++ b/ccpp/suites/suite_FV3_GFS_v15.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf.xml b/ccpp/suites/suite_FV3_GFS_v15_gf.xml index 0d56e54c8..64fc74630 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_gf.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_gf.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml b/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml index 1e51e5a13..b5cf00148 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_gf_thompson.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15_mynn.xml b/ccpp/suites/suite_FV3_GFS_v15_mynn.xml index 8fffa33e8..e4fc86b39 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_mynn.xml @@ -56,7 +56,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15_ras.xml b/ccpp/suites/suite_FV3_GFS_v15_ras.xml new file mode 100644 index 000000000..406560a37 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15_ras.xml @@ -0,0 +1,94 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + samfshalcnv_post + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml new file mode 100644 index 000000000..9da3a4665 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml @@ -0,0 +1,89 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + moninshoc + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + shoc + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + m_micro_pre + m_micro + m_micro_post + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson.xml index a436c11c8..79f9f77fb 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml index 3de52fa45..93a969a87 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_thompson_mynn.xml @@ -51,7 +51,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15p2.xml b/ccpp/suites/suite_FV3_GFS_v15p2.xml index b4907bb1b..6691e1965 100644 --- a/ccpp/suites/suite_FV3_GFS_v15p2.xml +++ b/ccpp/suites/suite_FV3_GFS_v15p2.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15plus.xml b/ccpp/suites/suite_FV3_GFS_v15plus.xml index 837cba69f..05ec7217c 100644 --- a/ccpp/suites/suite_FV3_GFS_v15plus.xml +++ b/ccpp/suites/suite_FV3_GFS_v15plus.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GFS_v15plusras.xml b/ccpp/suites/suite_FV3_GFS_v15plusras.xml new file mode 100644 index 000000000..802ea11d5 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15plusras.xml @@ -0,0 +1,94 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdif + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + samfshalcnv_post + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v16beta.xml b/ccpp/suites/suite_FV3_GFS_v16beta.xml index 7f53d7f6f..525eec2a1 100644 --- a/ccpp/suites/suite_FV3_GFS_v16beta.xml +++ b/ccpp/suites/suite_FV3_GFS_v16beta.xml @@ -54,7 +54,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GSD_SAR.xml b/ccpp/suites/suite_FV3_GSD_SAR.xml index e563301c4..34cfb47a8 100644 --- a/ccpp/suites/suite_FV3_GSD_SAR.xml +++ b/ccpp/suites/suite_FV3_GSD_SAR.xml @@ -53,7 +53,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GSD_noah.xml b/ccpp/suites/suite_FV3_GSD_noah.xml index e9795b6ef..72dd78a17 100644 --- a/ccpp/suites/suite_FV3_GSD_noah.xml +++ b/ccpp/suites/suite_FV3_GSD_noah.xml @@ -51,7 +51,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GSD_v0.xml b/ccpp/suites/suite_FV3_GSD_v0.xml index 3f83b5dc5..3e8cc5bdf 100644 --- a/ccpp/suites/suite_FV3_GSD_v0.xml +++ b/ccpp/suites/suite_FV3_GSD_v0.xml @@ -53,7 +53,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_GSD_v0_drag_suite.xml b/ccpp/suites/suite_FV3_GSD_v0_drag_suite.xml index 8c56c07e5..eba0aeb6a 100644 --- a/ccpp/suites/suite_FV3_GSD_v0_drag_suite.xml +++ b/ccpp/suites/suite_FV3_GSD_v0_drag_suite.xml @@ -53,7 +53,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/ccpp/suites/suite_FV3_HAFS_ferhires_update_moist.xml b/ccpp/suites/suite_FV3_HAFS_ferhires_update_moist.xml index 375e9972d..973650818 100644 --- a/ccpp/suites/suite_FV3_HAFS_ferhires_update_moist.xml +++ b/ccpp/suites/suite_FV3_HAFS_ferhires_update_moist.xml @@ -49,7 +49,6 @@ GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 073f7defd..2c4b33739 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -383,7 +383,7 @@ subroutine State_RWFields_tiles(state,filename,timeslice,rc) character(len=*),parameter :: subname='(module_cap_cpl:State_RWFields_tiles)' ! local variables - + rc = ESMF_SUCCESS !call ESMF_LogWrite(trim(subname)//trim(filename)//": called", !ESMF_LOGMSG_INFO, rc=rc) diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 3b0b0be16..cd87e3925 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -86,7 +86,7 @@ module module_cplfields "inst_merid_wind_height_lowest ", & "inst_pres_height_lowest ", & "inst_height_lowest ", & - "mean_fprec_rate " & + "mean_fprec_rate " & ! "northward_wind_neutral ", & ! "eastward_wind_neutral ", & ! "upward_wind_neutral ", & @@ -139,7 +139,7 @@ module module_cplfields real(kind=8), allocatable, public :: exportData(:,:,:) ! Import Fields ---------------------------------------- - integer, public, parameter :: NimportFields = 16 + integer, public, parameter :: NimportFields = 17 logical, public :: importFieldsValid(NimportFields) type(ESMF_Field), target, public :: importFields(NimportFields) character(len=*), public, parameter :: importFieldsList(NimportFields) = (/ & @@ -163,13 +163,15 @@ module module_cplfields "inst_tracer_up_surface_flx ", & "inst_tracer_down_surface_flx ", & "inst_tracer_clmn_mass_dens ", & - "inst_tracer_anth_biom_flx " & + "inst_tracer_anth_biom_flx ", & + "wave_z0_roughness_length " & /) character(len=*), public, parameter :: importFieldTypes(NimportFields) = (/ & "t", & "s","s","s","s","s", & "s","s","s","s","s", & - "s","u","d","c","b" & + "s","u","d","c","b", & + "s" & /) ! Set importFieldShare to .true. if field is provided as memory reference ! from coupled components @@ -177,7 +179,8 @@ module module_cplfields .true. , & .false.,.false.,.false.,.false.,.false., & .false.,.false.,.false.,.false.,.false., & - .false.,.true. ,.true. ,.true. ,.true. & + .false.,.true. ,.true. ,.true. ,.true. , & + .false. & /) ! Methods diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 0a352846f..1c9136185 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -982,7 +982,7 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + !----------------------------------------------------------------------- !*** Use the internal Clock set by NUOPC layer for FV3 but update stopTime !----------------------------------------------------------------------- @@ -1037,7 +1037,7 @@ subroutine ModelAdvance(gcomp, rc) integrate: do while(.NOT.ESMF_ClockIsStopTime(clock_fv3, rc = RC)) ! !*** for forecast tasks - + timewri = mpi_wtime() call ESMF_LogWrite('Model Advance: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1272,7 +1272,7 @@ subroutine ModelAdvance_phase1(gcomp, rc) reconcileFlag = .true. !*** for forecast tasks - + call ESMF_LogWrite('Model Advance phase1: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1294,7 +1294,7 @@ end subroutine ModelAdvance_phase1 subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - + ! local variables type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -1321,7 +1321,7 @@ subroutine ModelAdvance_phase2(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) & call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE phase2: ") -! +! call ESMF_GridCompGet(gcomp, name=name, localpet=mype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1332,7 +1332,7 @@ subroutine ModelAdvance_phase2(gcomp, rc) ! !*** for forecast tasks - + timewri = mpi_wtime() call ESMF_LogWrite('Model Advance phase2: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) diff --git a/gfsphysics/GFS_layer/GFS_driver.F90 b/gfsphysics/GFS_layer/GFS_driver.F90 index 28695eb5e..b72225735 100644 --- a/gfsphysics/GFS_layer/GFS_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_driver.F90 @@ -357,7 +357,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & call ini_micro (Model%mg_dcs, Model%mg_qcvar, Model%mg_ts_auto_ice(1)) elseif (Model%fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, 1.01_kind_phys, & + tmelt, latvap, latice, Model%mg_rhmini, & Model%mg_dcs, Model%mg_ts_auto_ice, & Model%mg_qcvar, & Model%microp_uniform, Model%do_cldice, & @@ -370,7 +370,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & Model%mg_ncnst, Model%mg_ninst) elseif (Model%fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, 1.01_kind_phys, & + tmelt, latvap, latice, Model%mg_rhmini, & Model%mg_dcs, Model%mg_ts_auto_ice, & Model%mg_qcvar, & Model%mg_do_hail, Model%mg_do_graupel, & @@ -483,7 +483,7 @@ end subroutine GFS_initialize ! 5) interpolates coefficients for prognostic ozone calculation ! 6) performs surface data cycling via the GFS gcycle routine !------------------------------------------------------------------------- - subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & + subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag) implicit none diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 36266aab8..cf8a1527c 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -43,6 +43,7 @@ module module_physics_driver !--- CONSTANT PARAMETERS real(kind=kind_phys), parameter :: hocp = con_hvap/con_cp + real(kind=kind_phys), parameter :: epsln = 1.0d-10 real(kind=kind_phys), parameter :: qmin = 1.0d-10 real(kind=kind_phys), parameter :: qsmall = 1.0d-20 real(kind=kind_phys), parameter :: rainmin = 1.0d-13 @@ -829,8 +830,12 @@ subroutine GFS_physics_driver & ! lprnt = .false. ! do i=1,im -! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-29.55) < 0.201 & -! .and. abs(grid%xlat(i)*rad2dg+59.62) < 0.201 +! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-97.50) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-24.48) < 0.101 +! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-293.91) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg+72.02) < 0.101 +! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-113.48) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-21.07) < 0.101 ! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-169.453) < 0.501 & ! .and. abs(grid%xlat(i)*rad2dg-72.96) < 0.501 ! if (kdt == 1) & @@ -1126,7 +1131,7 @@ subroutine GFS_physics_driver & frland(i) = Sfcprop%landfrac(i) if (frland(i) > zero) dry(i) = .true. tem = one - frland(i) - if (tem > zero) then + if (tem > epsln) then if (flag_cice(i)) then if (fice(i) >= Model%min_seaice*tem) then icy(i) = .true. @@ -1141,17 +1146,15 @@ subroutine GFS_physics_driver & fice(i) = zero endif endif - if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) else fice(i) = zero endif ! ocean/lake area that is not frozen - tem1 = max(zero, tem - Sfcprop%fice(i)) - - if (tem1 > zero) then + if (tem-fice(i) > epsln) then wet(i) = .true. ! there is some open water! + if (.not. Model%cplflx) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) ! if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), tgice) - if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) +! if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif enddo else @@ -1213,11 +1216,16 @@ subroutine GFS_physics_driver & enddo if (.not. Model%cplflx .or. .not. Model%frac_grid) then - do i=1,im - Sfcprop%zorll(i) = Sfcprop%zorl(i) - Sfcprop%zorlo(i) = Sfcprop%zorl(i) -! Sfcprop%tisfc(i) = Sfcprop%tsfc(i) - enddo + if (Model%cplwav2atm) then + do i=1,im + Sfcprop%zorll(i) = Sfcprop%zorl(i) + enddo + else + do i=1,im + Sfcprop%zorll(i) = Sfcprop%zorl(i) + Sfcprop%zorlo(i) = Sfcprop%zorl(i) + enddo + endif endif do i=1,im if(wet(i)) then ! Water @@ -1712,10 +1720,10 @@ subroutine GFS_physics_driver & tsurf3(i,3) = tsurf3(i,3) + tem endif enddo - if (Model%cplflx) then + if (Model%cplflx) then ! apply only at ocean points tem1 = half / omz1 do i=1,im - if (wet(i)) then + if (wet(i) .and. Sfcprop%oceanfrac(i) > zero) then tem2 = one / Sfcprop%xz(i) dt_warm = (Sfcprop%xt(i)+Sfcprop%xt(i)) * tem2 if ( Sfcprop%xz(i) > omz1) then @@ -1726,7 +1734,7 @@ subroutine GFS_physics_driver & - Sfcprop%z_c(i)*Sfcprop%dt_cool(i))*tem1 endif TSEAl(i) = Sfcprop%tref(i) + dt_warm - Sfcprop%dt_cool(i) -! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse +! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse tsurf3(i,3) = TSEAl(i) endif enddo @@ -1773,13 +1781,12 @@ subroutine GFS_physics_driver & zsea1 = 0.001*real(Model%nstf_name(4)) zsea2 = 0.001*real(Model%nstf_name(5)) call get_dtzm_2d (Sfcprop%xt, Sfcprop%xz, Sfcprop%dt_cool, & - Sfcprop%z_c, wet, zsea1, zsea2, & - im, 1, dtzm) + Sfcprop%z_c, wet, zsea1, zsea2, im, 1, dtzm) do i=1,im ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then if (wet(i)) then - tsfc3(i,3) = max(271.2,Sfcprop%tref(i) + dtzm(i)) + tsfc3(i,3) = max(tgice,Sfcprop%tref(i) + dtzm(i)) ! tsfc3(i,3) = max(271.2,Sfcprop%tref(i) + dtzm(i)) - & ! (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse endif @@ -2035,8 +2042,8 @@ subroutine GFS_physics_driver & Sfcprop%tsfc(i) = txl*tsfc3(i,1) + txi*tice(i) + txo*tsfc3(i,3) ! Sfcprop%tsfc(i) = txl*tsfc3(i,1) + txi*tsfc3(i,2) + txo*tsfc3(i,3) - Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) - Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) +! Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) +! Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) Sfcprop%zorll(i) = zorl3(i,1) Sfcprop%zorlo(i) = zorl3(i,3) @@ -2113,7 +2120,7 @@ subroutine GFS_physics_driver & Sfcprop%zorll(i) = zorl3(i,1) Sfcprop%zorlo(i) = zorl3(i,3) - if (flag_cice(i)) then ! this was already done for lake ice in sfc_sice + if (flag_cice(i) .and. wet(i)) then ! this was already done for lake ice in sfc_sice txi = Sfcprop%fice(i) txo = one - txi evap(i) = txi * evap3(i,2) + txo * evap3(i,3) @@ -2209,8 +2216,8 @@ subroutine GFS_physics_driver & Coupling%nlwsfc_cpl (i) = Coupling%nlwsfc_cpl(i) + Coupling%nlwsfci_cpl(i)*dtf Coupling%t2mi_cpl (i) = Sfcprop%t2m(i) Coupling%q2mi_cpl (i) = Sfcprop%q2m(i) -! Coupling%tsfci_cpl (i) = Sfcprop%tsfc(i) - Coupling%tsfci_cpl (i) = tsfc3(i,3) + Coupling%tsfci_cpl (i) = Sfcprop%tsfc(i) +! Coupling%tsfci_cpl (i) = tsfc3(i,3) Coupling%psurfi_cpl (i) = Statein%pgr(i) enddo @@ -2338,12 +2345,16 @@ subroutine GFS_physics_driver & dvsfc1, dtsfc1, dqsfc1, dkt, Diag%hpbl, kinver, & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) -! if (lprnt) write(0,*)'aftmonshoc=',Statein%tgrs(ipr,:) -! if (lprnt) write(0,*)'aftmonshocq=',Statein%qgrs(ipr,:,1) -! if (lprnt) write(0,*)'aftmonshoctke=',Statein%qgrs(ipr,:,ntke) -! if (lprnt) write(0,*)'aftmonice=',Statein%qgrs(ipr,:,ntiw) -! if (lprnt) write(0,*)'aftmonwat=',Statein%qgrs(ipr,:,ntcw) -! if (lprnt) write(0,*)'aftmonshocdtdt=',dtdt(ipr,1:10) +! if (lprnt) then +! write(0,*)' aftpbl dtdt=',dtdt(ipr,:) +! write(0,*)' aftpbl dqdtv=',dqdt(ipr,:,1) +! write(0,*)'aftmonshoc=',Statein%tgrs(ipr,:) +! write(0,*)'aftmonshocq=',Statein%qgrs(ipr,:,1) +! write(0,*)'aftmonshoctke=',Statein%qgrs(ipr,:,ntke) +! write(0,*)'aftmonice=',Statein%qgrs(ipr,:,ntiw) +! write(0,*)'aftmonwat=',Statein%qgrs(ipr,:,ntcw) +! write(0,*)'aftmonshocdtdt=',dtdt(ipr,1:10) +! endif else if (Model%satmedmf) then if (Model%isatmedmf == 0) then ! initial version of satmedmfvdif (Nov 2018) @@ -2818,7 +2829,8 @@ subroutine GFS_physics_driver & endif ! if (lprnt) then -! write(0,*) ' dusfc1=',dusfc1(ipr),' kdt=',kdt,' lat=',lat +! write(0,*) ' dusfc1=',dusfc1(ipr),' kdt=',kdt +! write(0,*) ' dvsfc1=',dvsfc1(ipr),' kdt=',kdt ! write(0,*)' dtsfc1=',dtsfc1(ipr) ! write(0,*)' dqsfc1=',dqsfc1(ipr) ! write(0,*)' dtdtc=',(dtdt(ipr,k),k=1,15) @@ -2831,13 +2843,13 @@ subroutine GFS_physics_driver & if (Model%cplflx) then do i=1,im if (Sfcprop%oceanfrac(i) > zero) then ! Ocean only, NO LAKES -! if (Sfcprop%fice(i) == Sfcprop%oceanfrac(i)) then ! use results from CICE -! Coupling%dusfci_cpl(i) = dusfc_cice(i) -! Coupling%dvsfci_cpl(i) = dvsfc_cice(i) -! Coupling%dtsfci_cpl(i) = dtsfc_cice(i) -! Coupling%dqsfci_cpl(i) = dqsfc_cice(i) -! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - if (wet(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + if (fice(i) == Sfcprop%oceanfrac(i)) then ! use results from CICE + Coupling%dusfci_cpl(i) = dusfc_cice(i) + Coupling%dvsfci_cpl(i) = dvsfc_cice(i) + Coupling%dtsfci_cpl(i) = dtsfc_cice(i) + Coupling%dqsfci_cpl(i) = dqsfc_cice(i) + + elseif (wet(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point if (icy(i) .or. dry(i)) then tem1 = max(Diag%q1(i), 1.e-8) rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(one+con_fvirt*tem1)) @@ -2866,6 +2878,11 @@ subroutine GFS_physics_driver & Coupling%dtsfc_cpl (i) = Coupling%dtsfc_cpl(i) + Coupling%dtsfci_cpl(i) * dtf Coupling%dqsfc_cpl (i) = Coupling%dqsfc_cpl(i) + Coupling%dqsfci_cpl(i) * dtf ! + else + Coupling%dusfc_cpl(i) = huge + Coupling%dvsfc_cpl(i) = huge + Coupling%dtsfc_cpl(i) = huge + Coupling%dqsfc_cpl(i) = huge endif ! Ocean only, NO LAKES enddo endif @@ -3284,10 +3301,10 @@ subroutine GFS_physics_driver & ! print *,' dtdt=',dtdt(ipr,:) ! print *,' gu0=',gu0(ipr,:) ! print *,' gv0=',gv0(ipr,:) -! write(0,*) ' gt0=',(gt0(ipr,k),k=1,levs),' kdt=',kdt -! write(0,*)' gq0=',(gq0(ipr,k,1),k=1,levs),' lat=',lat -! write(0,*)' gq0i2=',(gq0(ipr,k,ntiw),k=1,levs),' lat=',lat -! write(0,*)' gq1=',(gq0(ipr,k,ntcw),k=1,levs) +! write(0,*) ' gt0=',(Stateout%gt0(ipr,k),k=1,levs),' kdt=',kdt +! write(0,*)' gq0=',(Stateout%gq0(ipr,k,1),k=1,levs) +! write(0,*)' gq0i2=',(Stateout%gq0(ipr,k,ntiw),k=1,levs) +! write(0,*)' gq1=',(Stateout%gq0(ipr,k,ntcw),k=1,levs) ! print *,' vvel=',vvel ! endif ! if (lprnt) write(7000,*)' bef convection gu0=',gu0(ipr,:) @@ -3364,6 +3381,7 @@ subroutine GFS_physics_driver & do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -3499,6 +3517,11 @@ subroutine GFS_physics_driver & rhc(:,:) = one !*## CCPP ## endif + +! if (lprnt) write(0,*)' clwice=',clw(ipr,:,1) +! if (lprnt) write(0,*)' clwwat=',clw(ipr,:,2) +! if (lprnt) write(0,*)' rhc=',rhc(ipr,:) + ! ! Call SHOC if do_shoc is true and shocaftcnv is false ! @@ -3564,6 +3587,8 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)'gq01=',Stateout%gq0(ipr,:,1) ! if (lprnt) write(0,*)'clwi=',clw(ipr,:,1) ! if (lprnt) write(0,*)'clwl=',clw(ipr,:,2) +! if (lprnt) write(0,*)'befncpi=',ncpi(ipr,:) +! if (lprnt) write(0,*)'tkh=',Tbd%phy_f3d(ipr,:,ntot3d-1) ! if (lprnt) write(0,*) ' befshoc hflx=',hflx(ipr),' evap=',evap(ipr),& ! ' stress=',stress(ipr) ! dtshoc = 60.0 @@ -3602,6 +3627,7 @@ subroutine GFS_physics_driver & lprnt, ipr, imp_physics, ncpl, ncpi) +! if (lprnt) write(0,*)'aftncpi=',ncpi(ipr,:) ! enddo ! if (imp_physics == Model%imp_physics_mg .and. Model%fprcp > 1) then ! do k=1,levs @@ -3612,7 +3638,7 @@ subroutine GFS_physics_driver & ! endif ! if (lprnt) write(0,*)'aftshocgt0=',Stateout%gt0(ipr,:) -! if (lprnt) write(0,*)'aftshocgq0=',Stateout%gq0(ipr,1:60,1) +! if (lprnt) write(0,*)'aftshocgq0=',Stateout%gq0(ipr,:,1) ! if (lprnt) write(0,*)' aft shoc tke=',clw(ipr,1:25,ntk), & ! &' kdt=',kdt,'xlon=',grid%xlon(ipr),' xlat=',grid%xlat(ipr) ! if (lprnt) write(0,*)' aftshoccld=',tbd%phy_f3d(ipr,:,ntot3d-2)*100 @@ -3926,8 +3952,8 @@ subroutine GFS_physics_driver & trcmin, ntk) !*## CCPP ## -! if (lprnt) write(0,*)' gt04=',Stateout%gt0(ipr,1:60) -! if (lprnt) write(0,*)' gq04=',Stateout%gq0(ipr,1:60,1) +! if (lprnt) write(0,*)' gt04=',Stateout%gt0(ipr,:) +! if (lprnt) write(0,*)' gq04=',Stateout%gq0(ipr,:,1) ! if (lprnt) write(0,*)'aftrasclw1=',clw(ipr,:,1) ! if (lprnt) write(0,*)'aftrasclw2=',clw(ipr,:,2) ! if (lprnt) write(0,*)'aftrastke=',clw(ipr,:,ntk) @@ -4047,6 +4073,13 @@ subroutine GFS_physics_driver & ! !----------------Convective gravity wave drag parameterization starting -------- +! if (lprnt) then +! write(0,*) ' befgwgt0=',Stateout%gt0(ipr,:) +! write(0,*) ' befgwgq0=',Stateout%gq0(ipr,:,1) +! write(0,*) ' do_cnvgwd=',Model%do_cnvgwd +! endif + +! DH* this block is in gwdc_pre !## CCPP ##* gwdc.f/gwdc_pre Note: The conditional above is not in the scheme, so ! the execution of the code below is controlled by its presence in the CCPP SDF ! --- ... calculate maximum convective heating rate @@ -4239,6 +4272,11 @@ subroutine GFS_physics_driver & deallocate(gwdcu, gwdcv) endif ! end if_cnvgwd (convective gravity wave drag) +! if (lprnt) then +! write(0,*) ' befgwegt0=',Stateout%gt0(ipr,:) +! write(0,*) ' befgwegq0=',Stateout%gq0(ipr,:,1) +! endif + ! if (lprnt) write(7000,*)' aft cnvgwd gu0=',gu0(ipr,:) ! if (lprnt) write(7000,*)' aft cnvgwd gv0=',gv0(ipr,:) ! &,' lat=',lat,' kdt=',kdt,' me=',me @@ -4298,6 +4336,10 @@ subroutine GFS_physics_driver & else nsamftrac = tottracer endif +! if (lprnt) then +! write(0,*) ' befshgt0=',Stateout%gt0(ipr,:) +! write(0,*) ' befshgq0=',Stateout%gq0(ipr,:,1) +! endif !*## CCPP ## !## CCPP ##* samfshalcnv.f/samfshalcnv_run call samfshalcnv (im, ix, levs, dtp, itc, Model%ntchm, ntk, nsamftrac, & @@ -4515,6 +4557,7 @@ subroutine GFS_physics_driver & ! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt) then if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & +! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs @@ -4577,6 +4620,16 @@ subroutine GFS_physics_driver & endif ! end if_ntcw !*## CCPP ## +! if (lprnt) then +! write(0,*)' aft shallow physics kdt=',kdt +! write(0,*)'qt0s=',Stateout%gt0(ipr,:) +! write(0,*)'qq0s=',Stateout%gq0(ipr,:,1) +! write(0,*)'qq0ws=',Stateout%gq0(ipr,:,ntcw) +! write(0,*)'qq0is=',Stateout%gq0(ipr,:,ntiw) +! write(0,*)'qq0ntic=',Stateout%gq0(ipr,:,ntinc) +! write(0,*)'qq0os=',Stateout%gq0(ipr,:,ntoz) +! endif + ! Legacy routine which determines convectve clouds - should be removed at some point !## CCPP ## cnvc90.f/cnvc90_run call cnvc90 (Model%clstp, im, ix, Diag%rainc, kbot, ktop, levs, Statein%prsi, & @@ -4784,12 +4837,13 @@ subroutine GFS_physics_driver & Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3), & ims,ime, kms,kme, & its,ite, kts,kte) +! !*## CCPP ## - elseif (imp_physics == Model%imp_physics_mg) then ! MGB double-moment microphysics - ! ------------------------------ + elseif (imp_physics == Model%imp_physics_mg) then ! MGB double-moment microphysics + ! ------------------------------ !## CCPP ##* GFS_typedefs.F90/control_initialize - kk = 5 - if (Model%fprcp >= 2) kk = 6 + kk = 5 + if (Model%fprcp >= 2) kk = 6 !*## CCPP ## ! Acheng used clw here for other code to run smoothly and minimum change ! to make the code work. However, the nc and clw should be treated @@ -4797,86 +4851,86 @@ subroutine GFS_physics_driver & ! year. I believe this will make the physical interaction more reasonable ! Anning 12/5/2015 changed ntcw hold liquid only !## CCPP ##* m_micro_insterstitial.F90/m_micro_pre_run - if (Model%do_shoc) then - skip_macro = Model%do_shoc - if (Model%fprcp == 0) then - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water - Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + if (Model%do_shoc) then + skip_macro = Model%do_shoc + if (Model%fprcp == 0) then + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + enddo enddo - enddo - elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water - qrn(i,k) = Stateout%gq0(i,k,ntrw) - qsnw(i,k) = Stateout%gq0(i,k,ntsw) - ncpr(i,k) = Stateout%gq0(i,k,ntrnc) - ncps(i,k) = Stateout%gq0(i,k,ntsnc) - Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + ncpr(i,k) = Stateout%gq0(i,k,ntrnc) + ncps(i,k) = Stateout%gq0(i,k,ntsnc) + Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + enddo enddo - enddo - else - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water - qrn(i,k) = Stateout%gq0(i,k,ntrw) - qsnw(i,k) = Stateout%gq0(i,k,ntsw) - qgl(i,k) = Stateout%gq0(i,k,ntgl) - ncpr(i,k) = Stateout%gq0(i,k,ntrnc) - ncps(i,k) = Stateout%gq0(i,k,ntsnc) - ncgl(i,k) = Stateout%gq0(i,k,ntgnc) - Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + else + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + qgl(i,k) = Stateout%gq0(i,k,ntgl) + ncpr(i,k) = Stateout%gq0(i,k,ntrnc) + ncps(i,k) = Stateout%gq0(i,k,ntsnc) + ncgl(i,k) = Stateout%gq0(i,k,ntgnc) + Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc + enddo enddo - enddo - endif + endif - else + else ! clouds from t-dt and cnvc - if (Model%fprcp == 0 ) then - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + if (Model%fprcp == 0 ) then + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + enddo enddo - enddo - elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water - qrn(i,k) = Stateout%gq0(i,k,ntrw) - qsnw(i,k) = Stateout%gq0(i,k,ntsw) - ncpr(i,k) = Stateout%gq0(i,k,ntrnc) - ncps(i,k) = Stateout%gq0(i,k,ntsnc) + elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + ncpr(i,k) = Stateout%gq0(i,k,ntrnc) + ncps(i,k) = Stateout%gq0(i,k,ntsnc) + enddo enddo - enddo - else - do k=1,levs - do i=1,im - clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice - clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water - qrn(i,k) = Stateout%gq0(i,k,ntrw) - qsnw(i,k) = Stateout%gq0(i,k,ntsw) - qgl(i,k) = Stateout%gq0(i,k,ntgl) - ncpr(i,k) = Stateout%gq0(i,k,ntrnc) - ncps(i,k) = Stateout%gq0(i,k,ntsnc) - ncgl(i,k) = Stateout%gq0(i,k,ntgnc) + else + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntiw) ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) ! water + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + qgl(i,k) = Stateout%gq0(i,k,ntgl) + ncpr(i,k) = Stateout%gq0(i,k,ntrnc) + ncps(i,k) = Stateout%gq0(i,k,ntsnc) + ncgl(i,k) = Stateout%gq0(i,k,ntgnc) + enddo enddo - enddo + endif endif - endif ! add convective cloud fraction - do k = 1,levs - do i = 1,im - Tbd%phy_f3d(i,k,1) = min(one, Tbd%phy_f3d(i,k,1) + clcn(i,k)) + do k = 1,levs + do i = 1,im + Tbd%phy_f3d(i,k,1) = min(one, Tbd%phy_f3d(i,k,1) + clcn(i,k)) + enddo enddo - enddo !*## CCPP ## ! notice clw ix instead of im @@ -4886,6 +4940,7 @@ subroutine GFS_physics_driver & ! if(lprnt) write(0,*) ' befgt0=',Stateout%gt0(ipr,:),' kdt=',kdt ! if(lprnt) write(0,*) ' befgq0=',Stateout%gq0(ipr,:,1),' kdt=',kdt ! if(lprnt) write(0,*) ' befntlnc=',Stateout%gq0(ipr,:,ntlnc),' kdt=',kdt +! if(lprnt) write(0,*) ' befntinc=',Stateout%gq0(ipr,:,ntinc),' kdt=',kdt ! if (lprnt) write(0,*)' clw1bef=',clw(ipr,:,1),' kdt=',kdt ! if (lprnt) write(0,*)' clw2bef=',clw(ipr,:,2),' kdt=',kdt ! if (lprnt) write(0,*)' qrnb=',qrn(ipr,:),' kdt=',kdt @@ -4899,31 +4954,32 @@ subroutine GFS_physics_driver & ! do k=1,levs ! write(1000+me,*)' maxwatncb=',maxval(Stateout%gq0(1:im,k,ntlnc)),' k=',k,' kdt',kdt ! enddo + !## CCPP ##* m_micro.F90/m_micro_run - call m_micro_driver (im, ix, levs, Model%flipv, dtp, Statein%prsl, & - Statein%prsi, Statein%phil, Statein%phii, & - Statein%vvl, clw(1,1,2), QLCN, clw(1,1,1), QICN, & - Radtend%htrlw, Radtend%htrsw, w_upi, cf_upi, & - FRLAND, Diag%HPBL, CNV_MFD, CNV_DQLDT, & -! FRLAND, Diag%HPBL, CNV_MFD, CNV_PRC3, CNV_DQLDT, & - CLCN, Stateout%gu0, Stateout%gv0, Diag%dusfc, & - Diag%dvsfc, dusfc1, dvsfc1, dusfc1, dvsfc1, & - CNV_FICE, CNV_NDROP, CNV_NICE, Stateout%gq0(1,1,1), & - Stateout%gq0(1,1,ntcw), & - Stateout%gq0(1,1,ntiw), Stateout%gt0, rain1, & - Diag%sr, Stateout%gq0(1,1,ntlnc), & - Stateout%gq0(1,1,ntinc), Model%fprcp, qrn, & - qsnw, qgl, ncpr, ncps, ncgl, & - Tbd%phy_f3d(1,1,1), kbot, & - Tbd%phy_f3d(1,1,2), Tbd%phy_f3d(1,1,3), & - Tbd%phy_f3d(1,1,4), Tbd%phy_f3d(1,1,5), & - Tbd%phy_f3d(1,1,kk), Tbd%aer_nm, & - Model%aero_in, Tbd%in_nm, Tbd%ccn_nm, Model%iccn, & - skip_macro, lprnt, & -! skip_macro, cn_prc, cn_snr, lprnt, & -! ipr, kdt, Grid%xlat, Grid%xlon) - Model%mg_alf, Model%mg_qcmin, Model%pdfflag, & - ipr, kdt, Grid%xlat, Grid%xlon, rhc) + call m_micro_driver (im, ix, levs, Model%flipv, dtp, Statein%prsl, & + Statein%prsi, Statein%phil, Statein%phii, & + Statein%vvl, clw(1,1,2), QLCN, clw(1,1,1), QICN, & + Radtend%htrlw, Radtend%htrsw, w_upi, cf_upi, & + FRLAND, Diag%HPBL, CNV_MFD, CNV_DQLDT, & +! FRLAND, Diag%HPBL, CNV_MFD, CNV_PRC3, CNV_DQLDT, & + CLCN, Stateout%gu0, Stateout%gv0, Diag%dusfc, & + Diag%dvsfc, dusfc1, dvsfc1, dusfc1, dvsfc1, & + CNV_FICE, CNV_NDROP, CNV_NICE, Stateout%gq0(1,1,1), & + Stateout%gq0(1,1,ntcw), & + Stateout%gq0(1,1,ntiw), Stateout%gt0, rain1, & + Diag%sr, Stateout%gq0(1,1,ntlnc), & + Stateout%gq0(1,1,ntinc), Model%fprcp, qrn, & + qsnw, qgl, ncpr, ncps, ncgl, & + Tbd%phy_f3d(1,1,1), kbot, & + Tbd%phy_f3d(1,1,2), Tbd%phy_f3d(1,1,3), & + Tbd%phy_f3d(1,1,4), Tbd%phy_f3d(1,1,5), & + Tbd%phy_f3d(1,1,kk), Tbd%aer_nm, & + Model%aero_in, Tbd%in_nm, Tbd%ccn_nm, Model%iccn, & + skip_macro, lprnt, & +! skip_macro, cn_prc, cn_snr, lprnt, & +! ipr, kdt, Grid%xlat, Grid%xlon) + Model%mg_alf, Model%mg_qcmin, Model%pdfflag, & + ipr, kdt, Grid%xlat, Grid%xlon, rhc) !*## CCPP ## ! do k=1,levs ! write(1000+me,*)' maxwatnca=',maxval(Stateout%gq0(1:im,k,ntlnc)),' k=',k,' kdt=',kdt @@ -4944,7 +5000,7 @@ subroutine GFS_physics_driver & ! &,' cn_prc=',cn_prc(ipr),' cn_snr=',cn_snr(ipr),' kdt=',kdt ! if(lprnt) write(0,*) ' aftgt0=',Stateout%gt0(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*) ' aftlsgq0=',stateout%gq0(ipr,:,1),' kdt=',kdt -! if (lprnt) write(0,*)' clw1aft=',stateout%gq0(ipr,:,ntiw),' kdt=',kdt +! if (lprnt) write(0,*)' cli1aft=',stateout%gq0(ipr,:,ntiw),' kdt=',kdt ! if (ntgl > 0 .and. lprnt) & ! write(0,*)' cgw1aft=',stateout%gq0(ipr,:,ntgl),' kdt=',kdt ! if (lprnt) write(0,*)' cloudsm=',tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt @@ -4952,44 +5008,47 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' qrna=',qrn(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt + !## CCPP ##* m_micro_interstitial.F90/m_micro_post_run - tem = dtp * con_p001 / con_day - if (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then - do k=1,levs + + tem = dtp * con_p001 / con_day + if (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then + do k=1,levs + do i=1,im + if (abs(qrn(i,k)) < qsmall) qrn(i,k) = zero + if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = zero + Stateout%gq0(i,k,ntrw) = qrn(i,k) + Stateout%gq0(i,k,ntsw) = qsnw(i,k) + Stateout%gq0(i,k,ntrnc) = ncpr(i,k) + Stateout%gq0(i,k,ntsnc) = ncps(i,k) + enddo + enddo do i=1,im - if (abs(qrn(i,k)) < qsmall) qrn(i,k) = zero - if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = zero - Stateout%gq0(i,k,ntrw) = qrn(i,k) - Stateout%gq0(i,k,ntsw) = qsnw(i,k) - Stateout%gq0(i,k,ntrnc) = ncpr(i,k) - Stateout%gq0(i,k,ntsnc) = ncps(i,k) + Diag%ice(i) = tem * Stateout%gq0(i,1,ntiw) + Diag%snow(i) = tem * qsnw(i,1) + enddo + elseif (Model%fprcp > 1) then + do k=1,levs + do i=1,im + if (abs(qrn(i,k)) < qsmall) qrn(i,k) = zero + if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = zero + if (abs(qgl(i,k)) < qsmall) qgl(i,k) = zero + Stateout%gq0(i,k,ntrw) = qrn(i,k) + Stateout%gq0(i,k,ntsw) = qsnw(i,k) + Stateout%gq0(i,k,ntgl) = qgl(i,k) + Stateout%gq0(i,k,ntrnc) = ncpr(i,k) + Stateout%gq0(i,k,ntsnc) = ncps(i,k) + Stateout%gq0(i,k,ntgnc) = ncgl(i,k) + enddo enddo - enddo - do i=1,im - Diag%ice(i) = tem * Stateout%gq0(i,1,ntiw) - Diag%snow(i) = tem * qsnw(i,1) - enddo - elseif (Model%fprcp > 1) then - do k=1,levs do i=1,im - if (abs(qrn(i,k)) < qsmall) qrn(i,k) = zero - if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = zero - if (abs(qgl(i,k)) < qsmall) qgl(i,k) = zero - Stateout%gq0(i,k,ntrw) = qrn(i,k) - Stateout%gq0(i,k,ntsw) = qsnw(i,k) - Stateout%gq0(i,k,ntgl) = qgl(i,k) - Stateout%gq0(i,k,ntrnc) = ncpr(i,k) - Stateout%gq0(i,k,ntsnc) = ncps(i,k) - Stateout%gq0(i,k,ntgnc) = ncgl(i,k) + Diag%ice(i) = tem * Stateout%gq0(i,1,ntiw) + Diag%snow(i) = tem * qsnw(i,1) + Diag%graupel(i) = tem * qgl(i,1) enddo - enddo - do i=1,im - Diag%ice(i) = tem * Stateout%gq0(i,1,ntiw) - Diag%snow(i) = tem * qsnw(i,1) - Diag%graupel(i) = tem * qgl(i,1) - enddo + + endif !*## CCPP ## - endif ! if (lprnt) write(0,*)' cloudsm=',tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt ! if (lprnt) write(0,*)' clw2aft=',stateout%gq0(ipr,:,ntcw),' kdt=',kdt @@ -5058,20 +5117,20 @@ subroutine GFS_physics_driver & reset) tem = dtp * con_p001 / con_day do i = 1, im -! rain0(i,1) = max(con_d00, rain0(i,1)) -! snow0(i,1) = max(con_d00, snow0(i,1)) -! ice0(i,1) = max(con_d00, ice0(i,1)) -! graupel0(i,1) = max(con_d00, graupel0(i,1)) - if(rain0(i,1)*tem < rainmin) then - rain0(i,1) = zero +! rain0(i,1) = max(con_d00, rain0(i,1)) +! snow0(i,1) = max(con_d00, snow0(i,1)) +! ice0(i,1) = max(con_d00, ice0(i,1)) +! graupel0(i,1) = max(con_d00, graupel0(i,1)) + if (rain0(i,1)*tem < rainmin) then + rain0(i,1) = zero endif - if(ice0(i,1)*tem < rainmin) then + if (ice0(i,1)*tem < rainmin) then ice0(i,1) = zero endif - if(snow0(i,1)*tem < rainmin) then + if (snow0(i,1)*tem < rainmin) then snow0(i,1) = zero endif - if(graupel0(i,1)*tem < rainmin) then + if (graupel0(i,1)*tem < rainmin) then graupel0(i,1) = zero endif @@ -5111,7 +5170,7 @@ subroutine GFS_physics_driver & enddo - if(Model%effr_in) then + if (Model%effr_in) then do i =1, im den(i,k) = 0.622*Statein%prsl(i,k) / & (con_rd*Stateout%gt0(i,k)*(Stateout%gq0(i,k,1)+0.622)) @@ -5121,25 +5180,25 @@ subroutine GFS_physics_driver & !*## CCPP ## !## CCPP ##* maximum_hourly_diagnostics.F90/maximum_hourly_diagnsostics_run !Calculate hourly max 1-km agl and -10C reflectivity - if (Model%lradar .and. & - (imp_physics == Model%imp_physics_gfdl .or. & - imp_physics == Model%imp_physics_thompson)) then - allocate(refd(im)) - allocate(refd263k(im)) - call max_fields(Statein%phil,Diag%refl_10cm,con_g,im,levs,refd,Stateout%gt0,refd263k) - if (reset) then + if (Model%lradar .and. & + (imp_physics == Model%imp_physics_gfdl .or. & + imp_physics == Model%imp_physics_thompson)) then + allocate(refd(im)) + allocate(refd263k(im)) + call max_fields(Statein%phil,Diag%refl_10cm,con_g,im,levs,refd,Stateout%gt0,refd263k) + if (reset) then + do i=1,im + Diag%refdmax(I) = -35. + Diag%refdmax263k(I) = -35. + enddo + endif do i=1,im - Diag%refdmax(I) = -35. - Diag%refdmax263k(I) = -35. + Diag%refdmax(i) = max(Diag%refdmax(i),refd(i)) + Diag%refdmax263k(i) = max(Diag%refdmax263k(i),refd263k(i)) enddo + deallocate (refd) + deallocate (refd263k) endif - do i=1,im - Diag%refdmax(i) = max(Diag%refdmax(i),refd(i)) - Diag%refdmax263k(i) = max(Diag%refdmax263k(i),refd263k(i)) - enddo - deallocate (refd) - deallocate (refd263k) - endif !*## CCPP ## !## CCPP ##* gfdl_cloud_microphys.F90/gfdl_cloud_microphys_run if(Model%effr_in) then @@ -5152,23 +5211,23 @@ subroutine GFS_physics_driver & Tbd%phy_f3d(1:im,1:levs,1), Tbd%phy_f3d(1:im,1:levs,2), & Tbd%phy_f3d(1:im,1:levs,3), Tbd%phy_f3d(1:im,1:levs,4), & Tbd%phy_f3d(1:im,1:levs,5)) + !*## CCPP ## -! do k = 1, levs -! do i=1,im -! -! if(Model%me==0) then -! if(Tbd%phy_f3d(i,k,1) > 5.) then -! write(6,*) 'phy driver:cloud radii:',Model%kdt, i,k, & -! Tbd%phy_f3d(i,k,1) -! endif -! if(Tbd%phy_f3d(i,k,3)> zero) then -! write(6,*) 'phy driver:rain radii:',Model%kdt, i,k, & -! Tbd%phy_f3d(i,k,3) -! endif -! -! endif -! enddo -! enddo +! do k = 1, levs +! do i=1,im +! if(Model%me==0) then +! if(Tbd%phy_f3d(i,k,1) > 5.) then +! write(6,*) 'phy driver:cloud radii:',Model%kdt, i,k, & +! Tbd%phy_f3d(i,k,1) +! endif +! if(Tbd%phy_f3d(i,k,3)> zero) then +! write(6,*) 'phy driver:rain radii:',Model%kdt, i,k, & +! Tbd%phy_f3d(i,k,3) +! endif +! +! endif +! enddo +! enddo endif @@ -5228,9 +5287,10 @@ subroutine GFS_physics_driver & rain1(i) = max(rain1(i) - temrain1(i)*0.001, 0.0_kind_phys) enddo endif + !*## CCPP ## !## CCPP ##* GFS_MP_generic.F90/GFS_MP_generic_post_run - Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) + Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) ! total rain per timestep ! --- get the amount of different precip type for Noah MP ! --- convert from m/dtp to mm/s @@ -5386,6 +5446,7 @@ subroutine GFS_physics_driver & enddo elseif( .not. Model%cal_pre) then if (Model%imp_physics == Model%imp_physics_mg) then ! MG microphysics + tem = con_day / (dtp * con_p001) ! mm / day do i=1,im Sfcprop%tprcp(i) = max(zero, Diag%rain(i) ) ! clu: rain -> tprcp if (Diag%rain(i)*tem > rainmin) then @@ -5406,7 +5467,6 @@ subroutine GFS_physics_driver & endif - ! --- ... coupling insertion if (Model%cplflx .or. Model%cplchm) then @@ -5544,7 +5604,15 @@ subroutine GFS_physics_driver & ! &' rain=',rain(ipr),' rainc=',rainc(ipr) ! if (lprnt) call mpi_quit(7) ! if (kdt > 2 ) call mpi_quit(70) -! if (lprnt) write(0,*)'qt0out=',Stateout%gt0(ipr,:) & +! if (lprnt) then +! write(0,*)' at the end of physics kdt=',kdt +! write(0,*)' end rain=',diag%rain(ipr),' rainc=',diag%rainc(ipr) +! write(0,*)'qt0out=',Stateout%gt0(ipr,:) +! write(0,*)'qq0outv=',Stateout%gq0(ipr,:,1) +! write(0,*)'qq0outw=',Stateout%gq0(ipr,:,ntcw) +! write(0,*)'qq0outi=',Stateout%gq0(ipr,:,ntiw) +! write(0,*)'qq0outo=',Stateout%gq0(ipr,:,ntoz) +! endif ! if (lprnt) write(0,*)'gq0outtke=',Stateout%gq0(ipr,1:25,ntke) & ! ,'xlon=',grid%xlon(ipr)*rad2dg,' xlat=',grid%xlat(ipr)*rad2dg ! if (lprnt) write(0,*)' clouddriverend=',Tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index 8df014231..d14eeaac3 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -1879,23 +1879,23 @@ subroutine GFS_radiation_driver & ! print *,' in grrad : calling swrad' if (Model%swhtr) then - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & sfcalb, dz, delp, de_lgth, & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs + htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs cldtausw, & hsw0=htsw0, fdncmp=scmpsw) ! --- optional else - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & sfcalb, dz, delp, de_lgth, & Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs + htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs cldtausw, & - FDNCMP=scmpsw) ! --- optional + FDNCMP=scmpsw) ! --- optional endif !*## CCPP ## @@ -1904,7 +1904,7 @@ subroutine GFS_radiation_driver & k1 = k + kd Radtend%htrsw(1:im,k) = htswc(1:im,k1) enddo -! We are assuming that radiative tendencies are from bottom to top +! We are assuming that radiative tendencies are from bottom to top ! --- repopulate the points above levr i.e. LM if (lm < levs) then do k = lm,levs @@ -1920,7 +1920,7 @@ subroutine GFS_radiation_driver & ! --- repopulate the points above levr i.e. LM if (lm < levs) then do k = lm,levs - Radtend%swhc(1:im,k) = Radtend%swhc(1:im,LM) + Radtend%swhc(1:im,k) = Radtend%swhc(1:im,LM) enddo endif endif @@ -1985,7 +1985,7 @@ subroutine GFS_radiation_driver & call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprime(:,1), IM, & + tsfg, tsfa, Sfcprop%hprime(:,1), IM, & Radtend%semis) ! --- outputs !*## CCPP ## diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 8cef85314..ea56d63a4 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -8,7 +8,8 @@ module GFS_typedefs con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & con_epsm1, con_ttp, rlapse, con_jcal, con_rhw0, & - con_sbc, con_tice, cimin, con_p0, rhowater + con_sbc, con_tice, cimin, con_p0, rhowater, & + con_csol use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, NBDLW #else @@ -228,12 +229,12 @@ module GFS_typedefs !< [tsea in gbphys.f] real (kind=kind_phys), pointer :: tsfco (:) => null() !< sst in K real (kind=kind_phys), pointer :: tsfcl (:) => null() !< surface land temperature in K - real (kind=kind_phys), pointer :: tisfc (:) => null() !< surface temperature over ice fraction + real (kind=kind_phys), pointer :: tisfc (:) => null() !< surface temperature over ice fraction real (kind=kind_phys), pointer :: snowd (:) => null() !< snow depth water equivalent in mm ; same as snwdph - real (kind=kind_phys), pointer :: zorl (:) => null() !< composite surface roughness in cm - real (kind=kind_phys), pointer :: zorlo (:) => null() !< ocean surface roughness in cm - real (kind=kind_phys), pointer :: zorll (:) => null() !< land surface roughness in cm - real (kind=kind_phys), pointer :: fice (:) => null() !< ice fraction over open water grid + real (kind=kind_phys), pointer :: zorl (:) => null() !< composite surface roughness in cm + real (kind=kind_phys), pointer :: zorlo (:) => null() !< ocean surface roughness in cm + real (kind=kind_phys), pointer :: zorll (:) => null() !< land surface roughness in cm + real (kind=kind_phys), pointer :: fice (:) => null() !< ice fraction over open water grid ! real (kind=kind_phys), pointer :: hprim (:) => null() !< topographic standard deviation in m real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics @@ -429,7 +430,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ficein_cpl(:) => null() !< aoi_fld%ficein(item,lan) real (kind=kind_phys), pointer :: hicein_cpl(:) => null() !< aoi_fld%hicein(item,lan) real (kind=kind_phys), pointer :: hsnoin_cpl(:) => null() !< aoi_fld%hsnoin(item,lan) - !--- only variable needed for cplwav=.TRUE. + !--- only variable needed for cplwav2atm=.TRUE. + real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model !--- also needed for ice/ocn coupling - Xingren real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) @@ -577,10 +579,11 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplwav !< default no cplwav collection + logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection !--- integrated dynamics through earth's atmosphere - logical :: lsidea + logical :: lsidea !vay 2018 GW physics switches @@ -672,9 +675,7 @@ module GFS_typedefs real(kind=kind_phys) :: mg_dcs !< Morrison-Gettelman microphysics parameters real(kind=kind_phys) :: mg_qcvar real(kind=kind_phys) :: mg_ts_auto_ice(2) !< ice auto conversion time scale -#ifdef CCPP real(kind=kind_phys) :: mg_rhmini !< relative humidity threshold parameter for nucleating ice -#endif real(kind=kind_phys) :: mg_ncnst !< constant droplet num concentration (m-3) real(kind=kind_phys) :: mg_ninst !< constant ice num concentration (m-3) @@ -683,11 +684,9 @@ module GFS_typedefs real(kind=kind_phys) :: mg_alf !< tuning factor for alphs in MG macrophysics real(kind=kind_phys) :: mg_qcmin(2) !< min liquid and ice mixing ratio in Mg macro clouds character(len=16) :: mg_precip_frac_method ! type of precipitation fraction method -#ifdef CCPP real(kind=kind_phys) :: tf real(kind=kind_phys) :: tcr real(kind=kind_phys) :: tcrf -#endif ! logical :: effr_in !< eg to turn on ffective radii for MG logical :: microp_uniform @@ -914,7 +913,7 @@ module GFS_typedefs !< cx = min([-0.7 ln(Nccn) + 24]*1.e-4, c0s) !< Nccn: CCN number concentration in cm^(-3) !< Until a realistic Nccn is provided, Nccns are assumed - !< as Nccn=100 for sea and Nccn=1000 for land + !< as Nccn=100 for sea and Nccn=1000 for land !--- near surface temperature model logical :: nst_anl !< flag for NSSTM analysis in gcycle/sfcsub @@ -929,12 +928,15 @@ module GFS_typedefs !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid !< flag for fractional grid + logical :: frac_grid_off !< flag for using fractional grid + logical :: ignore_lake !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value + real(kind=kind_phys) :: min_lake_height !< minimum lake height value real(kind=kind_phys) :: rho_h2o !< density of fresh water !--- surface layer z0 scheme - integer :: sfc_z0_type !< surface roughness options over ocean: + integer :: sfc_z0_type !< surface roughness options over ocean: !< 0=no change !< 6=areodynamical roughness over water with input 10-m wind !< 7=slightly decrease Cd for higher wind speed compare to 6 @@ -1001,7 +1003,7 @@ module GFS_typedefs integer :: ntke !< tracer index for kinetic energy integer :: nto !< tracer index for oxygen ion integer :: nto2 !< tracer index for oxygen - integer :: ntwa !< tracer index for water friendly aerosol + integer :: ntwa !< tracer index for water friendly aerosol integer :: ntia !< tracer index for ice friendly aerosol integer :: ntchm !< number of chemical tracers integer :: ntchs !< tracer index for first chemical tracer @@ -1059,9 +1061,9 @@ module GFS_typedefs #endif integer :: jdat(1:8) !< current forecast date and time !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) - integer :: imn !< current forecast month - real(kind=kind_phys) :: julian !< current forecast julian date - integer :: yearlen !< current length of the year + integer :: imn !< initial forecast month + real(kind=kind_phys) :: julian !< julian day using midnight of January 1 of forecast year as initial epoch + integer :: yearlen !< length of the current forecast year in days ! logical :: iccn !< using IN CCN forcing for MG2/3 #ifdef CCPP @@ -2444,6 +2446,13 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%v10mi_cpl = clear_val endif + if (Model%cplwav2atm) then + !--- incoming quantities + allocate (Coupling%zorlwav_cpl (IM)) + + Coupling%zorlwav_cpl = clear_val + end if + if (Model%cplflx) then !--- incoming quantities allocate (Coupling%slimskin_cpl (IM)) @@ -2622,7 +2631,7 @@ subroutine coupling_create (Coupling, IM, Model) endif !--- needed for Thompson's aerosol option - if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then + if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then allocate (Coupling%nwfa2d (IM)) allocate (Coupling%nifa2d (IM)) Coupling%nwfa2d = clear_val @@ -2650,18 +2659,16 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- modules #ifdef CCPP use physcons, only: con_rerth, con_pi +! use rascnv, only: nrcmax #else use physcons, only: dxmax, dxmin, dxinv, con_rerth, con_pi, rhc_max -#endif - use mersenne_twister, only: random_setseed, random_number -#ifndef CCPP use module_ras, only: nrcmax -#endif - use parse_tracers, only: get_tracer_index -#ifndef CCPP use wam_f107_kp_mod, only: f107_kp_size, f107_kp_interval, & f107_kp_skip_size, f107_kp_data_size #endif + use mersenne_twister, only: random_setseed, random_number + use parse_tracers, only: get_tracer_index +! implicit none !--- interface variables @@ -2720,6 +2727,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection logical :: cplwav = .false. !< default no cplwav collection + logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplchm = .false. !< default no cplchm collection !--- integrated dynamics through earth's atmosphere @@ -2785,9 +2793,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: mg_dcs = 200.0 !< Morrison-Gettelman microphysics parameters real(kind=kind_phys) :: mg_qcvar = 1.0 real(kind=kind_phys) :: mg_ts_auto_ice(2) = (/180.0,180.0/) !< ice auto conversion time scale -#ifdef CCPP real(kind=kind_phys) :: mg_rhmini = 1.01 !< relative humidity threshold parameter for nucleating ice -#endif real(kind=kind_phys) :: mg_ncnst = 100.e6 !< constant droplet num concentration (m-3) real(kind=kind_phys) :: mg_ninst = 0.15e6 !< constant ice num concentration (m-3) real(kind=kind_phys) :: mg_ngnst = 0.10e6 !< constant graupel/hail num concentration (m-3) = 0.1e6_r8 @@ -2795,10 +2801,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: mg_qcmin(2) = (/1.0d-9,1.0d-9/) !< min liquid and ice mixing ratio in Mg macro clouds real(kind=kind_phys) :: mg_berg_eff_factor = 2.0 !< berg efficiency factor character(len=16) :: mg_precip_frac_method = 'max_overlap' !< type of precipitation fraction method -#ifdef CCPP real(kind=kind_phys) :: tf = 258.16d0 real(kind=kind_phys) :: tcr = 273.16d0 -#endif ! logical :: effr_in = .false. !< flag to use effective radii of cloud species in radiation logical :: microp_uniform = .true. @@ -2964,6 +2968,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: psauras(2) = (/1.0d-3,1.0d-3/) !< [in] auto conversion coeff from ice to snow in ras real(kind=kind_phys) :: prauras(2) = (/2.0d-3,2.0d-3/) !< [in] auto conversion coeff from cloud to rain in ras real(kind=kind_phys) :: wminras(2) = (/1.0d-5,1.0d-5/) !< [in] water and ice minimum threshold for ras +#ifdef CCPP + integer :: nrcmax = 32 !< number of random numbers used in RAS +#endif real(kind=kind_phys) :: rbcr = 0.25 !< Critical Richardson Number in PBL scheme real(kind=kind_phys) :: shoc_parm(5) = (/7000.0,1.0,4.2857143,0.7,-999.0/) !< some tunable parameters for shoc @@ -3015,16 +3022,20 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(4) : zsea1 in mm !< nstf_name(5) : zsea2 in mm !--- fractional grid - logical :: frac_grid = .false. !< flag for fractional grid - real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value - real(kind=kind_phys) :: min_seaice = 1.0d-6 !< minimum sea ice value - real(kind=kind_phys) :: rho_h2o = rhowater !< fresh water density + logical :: frac_grid = .false. !< flag for fractional grid + logical :: frac_grid_off = .true. !< flag for using fractional grid + logical :: ignore_lake = .true. !< flag for ignoring lakes + real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value + real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value + real(kind=kind_phys) :: min_lake_height = 250.0 !< minimum lake height value + real(kind=kind_phys) :: rho_h2o = rhowater !< fresh water density !--- surface layer z0 scheme integer :: sfc_z0_type = 0 !< surface roughness options over ocean !< 0=no change !< 6=areodynamical roughness over water with input 10-m wind !< 7=slightly decrease Cd for higher wind speed compare to 6 + !< negative when cplwav2atm=.true. - i.e. two way wave coupling !--- background vertical diffusion real(kind=kind_phys) :: xkzm_m = 1.0d0 !< [in] bkgd_vdif_m background vertical diffusion for momentum @@ -3033,6 +3044,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: xkzminv = 0.3 !< diffusivity in inversion layers real(kind=kind_phys) :: moninq_fac = 1.0 !< turbulence diffusion coefficient factor real(kind=kind_phys) :: dspfac = 1.0 !< tke dissipative heating factor + real(kind=kind_phys) :: bl_upfr = 0.13 !< updraft fraction in boundary layer mass flux scheme real(kind=kind_phys) :: bl_dnfr = 0.1 !< downdraft fraction in boundary layer mass flux scheme @@ -3046,12 +3058,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iseed_ca = 0 integer :: nspinup = 1 logical :: do_ca = .false. - logical :: ca_sgs = .false. + logical :: ca_sgs = .false. logical :: ca_global = .false. logical :: ca_smooth = .false. logical :: isppt_deep = .false. real(kind=kind_phys) :: nthresh = 0.0 - !--- IAU options real(kind=kind_phys) :: iau_delthrs = 0 !< iau time interval (to scale increments) @@ -3093,7 +3104,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & fhzero, ldiag3d, lssav, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplwav, cplchm, lsidea, & + cplflx, cplwav, cplwav2atm, cplchm, lsidea, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, aero_in, iflip, isol, ico2, ialb, & isot, iems, iaer, icliq_sw, iovr_sw, iovr_lw, ictm, isubc_sw,& @@ -3102,12 +3113,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & iccn, & !--- microphysical parameterizations ncld, imp_physics, psautco, prautco, evpco, wminco, & -#ifdef CCPP fprcp, pdfflag, mg_dcs, mg_qcvar, mg_ts_auto_ice, mg_rhmini, & effr_in, tf, tcr, & -#else - fprcp, pdfflag, mg_dcs, mg_qcvar, mg_ts_auto_ice, effr_in, & -#endif microp_uniform, do_cldice, hetfrz_classnuc, & mg_do_graupel, mg_do_hail, mg_nccons, mg_nicons, mg_ngcons, & mg_ncnst, mg_ninst, mg_ngnst, sed_supersat, do_sb_physics, & @@ -3159,8 +3166,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & clam_shal, c0s_shal, c1_shal, pgcon_shal, asolfac_shal, & !--- near surface sea temperature model nst_anl, lsea, nstf_name, & - frac_grid, min_lakeice, min_seaice, & - frac_grid, & + frac_grid, min_lakeice, min_seaice, min_lake_height, & + frac_grid_off, ignore_lake, & !--- surface layer sfc_z0_type, & ! background vertical diffusion @@ -3281,6 +3288,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplwav = cplwav + Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm !--- integrated dynamics through earth's atmosphere @@ -3372,9 +3380,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%mg_dcs = mg_dcs Model%mg_qcvar = mg_qcvar Model%mg_ts_auto_ice = mg_ts_auto_ice -#ifdef CCPP Model%mg_rhmini = mg_rhmini -#endif Model%mg_alf = mg_alf Model%mg_qcmin = mg_qcmin Model%effr_in = effr_in @@ -3395,11 +3401,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%do_sb_physics = do_sb_physics Model%mg_precip_frac_method = mg_precip_frac_method Model%mg_berg_eff_factor = mg_berg_eff_factor -#ifdef CCPP Model%tf = tf Model%tcr = tcr Model%tcrf = 1.0/(tcr-tf) -#endif !--- Thompson MP parameters Model%ltaerosol = ltaerosol @@ -3478,12 +3482,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%do_aw = do_aw Model%cs_parm = cs_parm Model%do_shoc = do_shoc -#ifdef CCPP - if (Model%do_shoc) then - print *, "Error, update of SHOC from May 22 2019 not yet in CCPP" - stop - end if -#endif +!#ifdef CCPP +! if (Model%do_shoc) then +! print *, "Error, update of SHOC from May 22 2019 not yet in CCPP" +! stop +! end if +!#endif Model%shoc_parm = shoc_parm Model%shocaftcnv = shocaftcnv Model%shoc_cld = shoc_cld @@ -3540,6 +3544,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%wminras = wminras Model%rbcr = rbcr Model%do_gwd = maxval(Model%cdmbgwd) > 0.0 + Model%do_cnvgwd = Model%cnvgwd .and. maxval(Model%cdmbgwd(3:4)) == 0.0 #ifdef CCPP Model%do_mynnedmf = do_mynnedmf @@ -3591,18 +3596,22 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- fractional grid Model%frac_grid = frac_grid + Model%frac_grid_off = frac_grid_off + Model%ignore_lake = ignore_lake #ifdef CCPP if (Model%frac_grid) then write(0,*) "ERROR: CCPP has not been tested with fractional landmask turned on" - stop +! stop end if #endif Model%min_lakeice = min_lakeice Model%min_seaice = min_seaice + Model%min_lake_height = min_lake_height Model%rho_h2o = rho_h2o !--- surface layer Model%sfc_z0_type = sfc_z0_type + if (Model%cplwav2atm) Model%sfc_z0_type = -1 !--- backgroud vertical diffusion Model%xkzm_m = xkzm_m @@ -3816,6 +3825,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- ps is replaced with p0. The value of p0 uses that in http://www.emc.ncep.noaa.gov/officenotes/newernotes/on461.pdf !--- ak/bk have been flipped from their original FV3 orientation and are defined sfc -> toa Model%si = (ak + bk * con_p0 - ak(Model%levr+1)) / (con_p0 - ak(Model%levr+1)) + + if (Model%lsm == Model%lsm_noahmp) then + Model%yearlen = 365 + Model%julian = -9999. + endif #endif #ifndef CCPP @@ -3854,15 +3868,15 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- set nrcm -#ifndef CCPP +!#ifndef CCPP if (Model%ras) then Model%nrcm = min(nrcmax, Model%levs-1) * (Model%dtp/1200.d0) + 0.10001d0 else Model%nrcm = 2 endif -#else - Model%nrcm = 2 -#endif +!#else +! Model%nrcm = 2 +!#endif !--- cal_pre if (Model%cal_pre) then @@ -3968,8 +3982,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if (Model%imp_physics /= Model%imp_physics_gfdl) stop 'iopt_snf == 4 must use GFDL MP' endif - print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid - print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice + print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,& + ' frac_grid_off=',frac_grid_off,' ignore_lake=',ignore_lake + print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice, & + 'min_lake_height=',Model%min_lake_height if (Model%nstf_name(1) > 0 ) then print *,' NSSTM is active ' print *,' nstf_name(1)=',Model%nstf_name(1) @@ -4093,7 +4109,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' do_gwd=',Model%do_gwd endif if (Model%do_cnvgwd) then - print *,' Convective GWD parameterization used, do_cnvgwd=',do_cnvgwd + print *,' Convective GWD parameterization used, do_cnvgwd=',Model%do_cnvgwd endif if (Model%crick_proof) print *,' CRICK-Proof cloud water used in radiation ' if (Model%ccnorm) print *,' Cloud condensate normalized by cloud cover for radiation' @@ -4394,6 +4410,7 @@ subroutine control_print(Model) print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx print *, ' cplwav : ', Model%cplwav + print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm print *, ' ' print *, 'integrated dynamics through earth atmosphere' @@ -4468,6 +4485,7 @@ subroutine control_print(Model) print *, ' mg_ts_auto_ice : ', Model%mg_ts_auto_ice print *, ' mg_alf : ', Model%mg_alf print *, ' mg_qcmin : ', Model%mg_qcmin + print *, ' mg_rhmini : ', Model%mg_rhmini print *, ' pdfflag : ', Model%pdfflag print *, ' ' endif @@ -5169,12 +5187,12 @@ subroutine diag_create (Diag, IM, Model) allocate (Diag%dv3dt (IM,Model%levs,4)) allocate (Diag%dt3dt (IM,Model%levs,7)) allocate (Diag%dq3dt (IM,Model%levs,9)) -! allocate (Diag%dq3dt (IM,Model%levs,oz_coeff+5)) +! allocate (Diag%dq3dt (IM,Model%levs,oz_coeff+5)) !--- needed to allocate GoCart coupling fields -! allocate (Diag%upd_mf (IM,Model%levs)) -! allocate (Diag%dwn_mf (IM,Model%levs)) -! allocate (Diag%det_mf (IM,Model%levs)) -! allocate (Diag%cldcov (IM,Model%levs)) +! allocate (Diag%upd_mf (IM,Model%levs)) +! allocate (Diag%dwn_mf (IM,Model%levs)) +! allocate (Diag%det_mf (IM,Model%levs)) +! allocate (Diag%cldcov (IM,Model%levs)) endif !vay-2018 @@ -5400,8 +5418,8 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%u10max = zero Diag%v10max = zero Diag%spd10max = zero - Diag%rain = zero - Diag%rainc = zero +! Diag%rain = zero +! Diag%rainc = zero Diag%ice = zero Diag%snow = zero Diag%graupel = zero @@ -6143,6 +6161,7 @@ subroutine interstitial_setup_tracers(Interstitial, Model) do n=2,Model%ntrac if ( n /= Model%ntcw .and. n /= Model%ntiw .and. n /= Model%ntclamt .and. & n /= Model%ntrw .and. n /= Model%ntsw .and. n /= Model%ntrnc .and. & +! n /= Model%ntlnc .and. n /= Model%ntinc .and. & n /= Model%ntsnc .and. n /= Model%ntgl .and. n /= Model%ntgnc) then tracers = tracers + 1 if (Model%ntke == n ) then @@ -6158,7 +6177,8 @@ subroutine interstitial_setup_tracers(Interstitial, Model) enddo Interstitial%tracers_total = tracers - 2 endif ! end if_ras or cfscnv or samf - if(.not. Model%satmedmf .and. .not. Model%trans_trac) then + if (.not. Model%satmedmf .and. .not. Model%trans_trac .and. & + .not. Model%ras .and. .not. Model%do_shoc) then Interstitial%nsamftrac = 0 else Interstitial%nsamftrac = Interstitial%tracers_total @@ -6331,9 +6351,9 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%gamq = clear_val Interstitial%gamt = clear_val Interstitial%gflx = clear_val - Interstitial%gflx_ice = zero - Interstitial%gflx_land = zero - Interstitial%gflx_ocean = zero + Interstitial%gflx_ice = clear_val + Interstitial%gflx_land = clear_val + Interstitial%gflx_ocean = clear_val Interstitial%gwdcu = clear_val Interstitial%gwdcv = clear_val Interstitial%hflx = clear_val diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index f84e6d095..48d26266b 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -148,42 +148,42 @@ kind = kind_phys [qgrs(:,:,index_for_liquid_cloud_condensate)] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [qgrs(:,1,index_for_liquid_cloud_condensate)] standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys [qgrs(:,:,index_for_ice_cloud_condensate)] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [qgrs(:,:,index_for_rain_water)] standard_name = rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [qgrs(:,:,index_for_snow_water)] standard_name = snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [qgrs(:,:,index_for_graupel)] standard_name = graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -335,35 +335,35 @@ kind = kind_phys [gq0(:,:,index_for_liquid_cloud_condensate)] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [gq0(:,:,index_for_ice_cloud_condensate)] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [gq0(:,:,index_for_rain_water)] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [gq0(:,:,index_for_snow_water)] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [gq0(:,:,index_for_graupel)] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -2025,6 +2025,12 @@ units = flag dimensions = () type = logical +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -2295,6 +2301,20 @@ dimensions = (2) type = real kind = kind_phys +[psauras] + standard_name = coefficient_from_cloud_ice_to_snow_ras + long_name = conversion coefficient from cloud ice to snow in ras + units = none + dimensions = (2) + type = real + kind = kind_phys +[prauras] + standard_name = coefficient_from_cloud_water_to_rain_ras + long_name = conversion coefficient from cloud water to rain in ras + units = none + dimensions = (2) + type = real + kind = kind_phys [evpco] standard_name = coefficient_for_evaporation_of_rainfall long_name = coeff for evaporation of largescale rain @@ -2309,6 +2329,20 @@ dimensions = (2) type = real kind = kind_phys +[wminras] + standard_name = cloud_condensed_water_ice_conversion_threshold_ras + long_name = conversion coefficient from cloud liquid and ice to precipitation in ras + units = none + dimensions = (2) + type = real + kind = kind_phys +[dlqf] + standard_name = condensate_fraction_detrained_in_updraft_layers + long_name = condensate fraction detrained with in a updraft layers + units = none + dimensions = (2) + type = real + kind = kind_phys [avg_max_length] standard_name = time_interval_for_maximum_hourly_fields long_name = reset time interval for maximum hourly fields @@ -2729,12 +2763,6 @@ units = index dimensions = () type = integer -[mom4ice] - standard_name = flag_for_mom4_coupling - long_name = flag controls mom4 sea ice - units = flag - dimensions = () - type = logical [ras] standard_name = flag_for_ras_deep_convection long_name = flag for ras convection scheme @@ -3019,6 +3047,13 @@ dimensions = (4) type = real kind = kind_phys +[ccwf] + standard_name = multiplication_factor_for_critical_cloud_workfunction + long_name = multiplication factor for tical_cloud_workfunction + units = none + dimensions = (2) + type = real + kind = kind_phys [sup] standard_name = ice_supersaturation_threshold long_name = ice supersaturation parameter for PDF clouds @@ -6182,14 +6217,14 @@ kind = kind_phys [clw(:,:,1)] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [clw(:,:,2)] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -6413,21 +6448,21 @@ kind = kind_phys [dqdt(:,:,index_for_rain_water)] standard_name = tendency_of_rain_water_mixing_ratio_due_to_model_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water tendency due to model physics + long_name = ratio of mass of rain water tendency to mass of dry air plus vapor (without condensates) due to model physics units = kg kg-1 s-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [dqdt(:,:,index_for_snow_water)] standard_name = tendency_of_snow_water_mixing_ratio_due_to_model_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water tendency due to model physics + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) due to model physics units = kg kg-1 s-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [dqdt(:,:,index_for_graupel)] standard_name = tendency_of_graupel_mixing_ratio_due_to_model_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel tendency due to model physics + long_name = ratio of mass of graupel tendency to mass of dry air plus vapor (without condensates) due to model physics units = kg kg-1 s-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -7455,7 +7490,7 @@ kind = kind_phys [qgl] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -7483,14 +7518,14 @@ kind = kind_phys [qrn] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -7622,7 +7657,7 @@ kind = kind_phys [save_q(:,:,index_for_liquid_cloud_condensate)] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -8572,3 +8607,12 @@ dimensions = () type = real kind = kind_phys +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F diff --git a/gfsphysics/physics/cires_ugwp_initialize.F90 b/gfsphysics/physics/cires_ugwp_initialize.F90 index fbcc1d205..fd2a32d6b 100644 --- a/gfsphysics/physics/cires_ugwp_initialize.F90 +++ b/gfsphysics/physics/cires_ugwp_initialize.F90 @@ -30,11 +30,11 @@ ! oro_stat(i,12) = gamm(i) ! oro_stat(i,13) = sigma(i) ! oro_stat(i,14) = elvmax(i) -! enddo +! enddo ! end subroutine fill_oro_stat ! end module oro_state - + module ugwp_common ! use machine, only: kind_phys @@ -181,7 +181,7 @@ module ugwp_oro_init real, parameter :: rlolev=50000.0 ! real, parameter :: hncrit=9000. ! max value in meters for elvmax - + ! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt real, parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor @@ -514,7 +514,7 @@ end module ugwp_lsatdis_init ! ! module ugwp_wmsdis_init - + use ugwp_common, only : pi, pi2 implicit none @@ -528,7 +528,7 @@ module ugwp_wmsdis_init real, parameter :: gssec = (6.28/30.)**2 ! max-value for bn2 real, parameter :: bv2min = (6.28/60./120.)**2 ! min-value for bn2 7.6(-7) 2 hrs real, parameter :: minvel = 0.5 - + ! ! make parameter list that will be passed to SOLVER ! @@ -541,11 +541,11 @@ module ugwp_wmsdis_init real , parameter :: nslope=1 ! the GW sprctral slope at small-m ! integer, parameter :: klaunch=55 ! 32 - ~ 1km ;55 - 5.5 km ; 52 4.7km ; 60-7km index for selecting launch level ! integer, parameter :: ilaunch=klaunch - + integer , parameter :: iazidim=4 ! number of azimuths integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum real , parameter :: ucrit2=0.5 - + real , parameter :: zcimin = ucrit2 real , parameter :: zcimax = 125.0 real , parameter :: zgam = 0.25 @@ -553,18 +553,18 @@ module ugwp_wmsdis_init integer :: ilaunch real :: gw_eff - + !=========================================================================== integer :: nwav, nazd, nst real :: eff - + real :: zaz_fct real, allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) real, allocatable :: zcosang(:), zsinang(:) contains !============================================================================ subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) - + ! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & ! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) ! diff --git a/gfsphysics/physics/cires_ugwp_triggers.F90 b/gfsphysics/physics/cires_ugwp_triggers.F90 index bb135b857..4c03d9c9d 100644 --- a/gfsphysics/physics/cires_ugwp_triggers.F90 +++ b/gfsphysics/physics/cires_ugwp_triggers.F90 @@ -10,8 +10,8 @@ SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & implicit none integer :: nx, ny real :: lon(nx), lat(ny) - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) real :: earth_r, ra1, ra2, dx, dy, dlat real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) integer :: j @@ -27,7 +27,7 @@ SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & rlat = lat*deg_to_rad rlon = lon*deg_to_rad tanlat = atan(rlat) - cosv = cos(rlat) + cosv = cos(rlat) dy = rlat(2)-rlat(1) dx = rlon(2)-rlon(1) ! @@ -37,17 +37,17 @@ SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & ! do j=2, ny-1 brcos(j) = 1.0 / cos(rlat(j))*ra1 - enddo - + enddo + brcos(1) = brcos(2) brcos(ny) = brcos(ny-1) brcos2 = brcos*brcos ! dlam1 = brcos / (dx+dx) dlam2 = brcos2 / (dx*dx) - + dlat = ra1 / (dy+dy) - + divJp = dlat*cosv divJM = dlat*cosv ! @@ -62,12 +62,12 @@ SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & ! return end SUBROUTINE subs_diag_geo -! +! subroutine get_xy_pt(V, Vx, Vy, nx, ny, dlam1, dlat) !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! compute for each Vert-column: grad(V) ! periodic in X and central diff ... -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ implicit none integer :: nx, ny real :: V(nx, ny), dlam1(ny), dlat @@ -438,7 +438,7 @@ subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, t print *, ' get_spectra_tau_okwgw ' do i=1, im k = klow - klev(i) = k + klev(i) = k dmax = abs(trig_okw(i,k)) kex = 0 if (dmax >= tlim_okw) kex = kex+1 @@ -448,16 +448,16 @@ subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, t if ( dtot > dmax) then klev(i) = k dmax = dtot - endif + endif enddo -! +! if (dmax >= tlim_okw) then nf_src = nf_src + 1 if_src(i) = 1 taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) endif - enddo + enddo print *, ' get_spectra_tau_okwgw ' end subroutine get_spectra_tau_okw ! @@ -468,16 +468,16 @@ subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* !================= implicit none - integer :: im + integer :: im real :: tau_amp, xlatdeg(im), tau_gw(im) real :: latdeg, flat_gw, tem integer :: i - + ! ! if-lat ! do i=1, im - latdeg = abs(xlatdeg(i)) + latdeg = abs(xlatdeg(i)) if (latdeg < 15.3) then tem = (latdeg-3.0) / 8.0 flat_gw = 0.75 * exp(-tem * tem) @@ -491,22 +491,22 @@ subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) tem = (latdeg-60.0) / 70.0 flat_gw = 0.50 * exp(- tem * tem) endif - tau_gw(i) = tau_amp*flat_gw + tau_gw(i) = tau_amp*flat_gw enddo -! +! end subroutine slat_geos5_tamp - + subroutine slat_geos5(im, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* !================= implicit none - integer :: im - real :: xlatdeg(im) + integer :: im + real :: xlatdeg(im) real :: tau_gw(im) real :: latdeg real, parameter :: tau_amp = 100.e-3 - real :: trop_gw, flat_gw + real :: trop_gw, flat_gw integer :: i ! ! if-lat @@ -532,7 +532,7 @@ subroutine slat_geos5(im, xlatdeg, tau_gw) end if tau_gw(i) = tau_amp*flat_gw enddo -! +! end subroutine slat_geos5 subroutine init_nazdir(naz, xaz, yaz) use ugwp_common , only : pi2 @@ -542,7 +542,7 @@ subroutine init_nazdir(naz, xaz, yaz) integer :: idir real :: phic, drad drad = pi2/float(naz) - if (naz.ne.4) then + if (naz.ne.4) then do idir =1, naz Phic = drad*(float(idir)-1.0) xaz(idir) = cos(Phic) @@ -552,11 +552,11 @@ subroutine init_nazdir(naz, xaz, yaz) ! if (naz.eq.4) then xaz(1) = 1.0 !E yaz(1) = 0.0 - xaz(2) = 0.0 + xaz(2) = 0.0 yaz(2) = 1.0 !N xaz(3) =-1.0 !W yaz(3) = 0.0 xaz(4) = 0.0 yaz(4) =-1.0 !S - endif + endif end subroutine init_nazdir diff --git a/gfsphysics/physics/dcyc2.f b/gfsphysics/physics/dcyc2.f index 6482060e0..a97b428b5 100644 --- a/gfsphysics/physics/dcyc2.f +++ b/gfsphysics/physics/dcyc2.f @@ -218,7 +218,7 @@ subroutine dcyc2t3 & enddo else rstl = one / float(nstl) - solang = pid12 * (solhr - hour12) + solang = pid12 * (solhr - hour12) anginc = pid12 * deltim * f3600 * rstl do i = 1, im xcosz(i) = zero diff --git a/gfsphysics/physics/gcm_shoc.f90 b/gfsphysics/physics/gcm_shoc.f90 index e48f4e3e4..f5791a049 100644 --- a/gfsphysics/physics/gcm_shoc.f90 +++ b/gfsphysics/physics/gcm_shoc.f90 @@ -35,7 +35,7 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & lfus => con_hfus, & ! Latent heat of fusion, J/kg rv => con_rv, & ! Gas constant for water vapor, J/kg/K rgas => con_rd, & ! Gas constant for dry air, J/kg/K - pi => con_pi, & ! Pi + pi => con_pi, & ! Pi epsv => con_fvirt implicit none @@ -62,25 +62,25 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers - integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) + integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) integer, intent(in) :: imp_phys! microphysics identifier - real, intent(in) :: dtn ! Physics time step, s + real, intent(in) :: dtn ! Physics time step, s real, intent(in) :: pcrit ! pressure in Pa below which additional tke dissipation is applied real, intent(in) :: cefac ! tunable multiplier to dissipation term real, intent(in) :: cesfac ! tunable multiplier to dissipation term for bottom level real, intent(in) :: tkef1 ! uncentering terms in implicit tke integration real, intent(in) :: dis_opt ! when > 0 use different formula for near surface dissipation - + real, intent(in) :: hflx(nx) real, intent(in) :: evap(nx) ! The interface is talored to GFS in a sense that input variables are 2D - real, intent(in) :: prsl (ix,nzm) ! mean layer presure - real, intent(in) :: delp (ix,nzm) ! layer presure depth + real, intent(in) :: prsl (ix,nzm) ! mean layer presure + real, intent(in) :: delp (ix,nzm) ! layer presure depth real, intent(in) :: phii (ix,nz ) ! interface geopotential height - real, intent(in) :: phil (ix,nzm) ! layer geopotential height + real, intent(in) :: phil (ix,nzm) ! layer geopotential height real, intent(in) :: u (ix,nzm) ! u-wind, m/s real, intent(in) :: v (ix,nzm) ! v-wind, m/s real, intent(in) :: omega (ix,nzm) ! omega, Pa/s @@ -92,12 +92,12 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & real, intent(inout) :: ncpl (nx,nzm) ! cloud water number concentration,/m^3 real, intent(inout) :: ncpi (nx,nzm) ! cloud ice number concentration,/m^3 - real, intent(inout) :: qpl (nx,nzm) ! rain mixing ratio, kg/kg - real, intent(inout) :: qpi (nx,nzm) ! snow mixing ratio, kg/kg + real, intent(in) :: qpl (nx,nzm) ! rain mixing ratio, kg/kg + real, intent(in) :: qpi (nx,nzm) ! snow mixing ratio, kg/kg real, intent(inout) :: rhc (nx,nzm) ! critical relative humidity real, intent(in) :: supice ! ice supersaturation parameter - real, intent(inout) :: cld_sgs(ix,nzm) ! sgs cloud fraction + real, intent(out) :: cld_sgs(ix,nzm) ! sgs cloud fraction ! real, intent(inout) :: cld_sgs(nx,nzm) ! sgs cloud fraction real, intent(inout) :: tke (ix,nzm) ! turbulent kinetic energy. m**2/s**2 ! real, intent(inout) :: tk (nx,nzm) ! eddy viscosity @@ -108,12 +108,12 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & ! SHOC tunable parameters real, parameter :: lambda = 0.04d0 -! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 +! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000.0d0 +! real, parameter :: max_eddy_length_scale = 2000.0d0 real, parameter :: max_eddy_length_scale = 1000.0d0 ! Maximum "return-to-isotropy" time scale, s real, parameter :: max_eddy_dissipation_time_scale = 2000.d0 @@ -122,13 +122,13 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & ! Constants for the TKE dissipation term based on Deardorff (1980) real, parameter :: pt19=0.19d0, pt51=0.51d0, pt01=0.01d0, atmin=0.01d0, atmax=one-atmin real, parameter :: Cs = 0.15d0, epsln=1.0d-6 -! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 +! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 real, parameter :: Ck = 0.1d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 -! real, parameter :: Ce = Ck**3/(0.7*Cs**4) -! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 -! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 3.0 , Ces = Ce -! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.5 , Ces = Ce * 3.0 / 2.5 +! real, parameter :: Ce = Ck**3/(0.7*Cs**4) +! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 +! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 3.0 , Ces = Ce +! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.5 , Ces = Ce * 3.0 / 2.5 ! real, parameter :: Ces = Ce/0.7*3.0 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4), Ces = Ce*3.0/0.7 ! Commented Moor @@ -168,7 +168,7 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & real zi (nx,nz) ! height of the interface levels, m real adzl (nx,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels real adzi (nx,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface - + real hl (nx,nzm) ! liquid/ice water static energy , K real qv (nx,nzm) ! water vapor, kg/kg real qcl (nx,nzm) ! liquid water (condensate), kg/kg @@ -176,8 +176,6 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & real w (nx,nzm) ! z-wind, m/s real bet (nx,nzm) ! ggr/tv0 real gamaz (nx,nzm) ! ggr/cp*z -! real qpi (nx,nzm) ! snow + graupel mixing ratio, kg/kg -! real qpl (nx,nzm) ! rain mixing ratio, kg/kg ! Moments of the trivariate double Gaussian PDF for the SGS total water mixing ratio ! SGS liquid/ice static energy, and vertical velocity @@ -256,12 +254,13 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,1,1:40) -! if (lprnt) write(0,*)' qcin=',qc(ipr,1,1:40) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,1,1:40) -! if (lprnt) write(0,*)' qiin=',qi(ipr,1,1:40) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,1,1:40) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,1,1:40) +! 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 ! @@ -289,7 +288,8 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & enddo enddo -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,1,1:40) +! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,:) +! if (lprnt) write(0,*)' qwvin2=',qwv(ipr,:) do k=1,nzm do i=1,nx @@ -318,11 +318,15 @@ subroutine shoc(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,1:40) +! if (lprnt) write(0,*)' hlin=',hl(ipr,1:40) ! Define vertical grid increments for later use in the vertical differentiation @@ -445,11 +449,16 @@ subroutine shoc(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() -! This subroutine solves the TKE equation, +! This subroutine solves the TKE equation, ! Heavily based on SAM's tke_full.f90 by Marat Khairoutdinov real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & @@ -476,10 +485,10 @@ subroutine tke_shoc() call check_eddy() ! Make sure it's reasonable tkef2 = 1.0 - tkef1 - do k=1,nzm + do k=1,nzm ku = k+1 kd = k - + ! Cek = Ce * cefac if(k == 1) then @@ -586,6 +595,8 @@ subroutine tke_shoc() isotropy(i,k) = min(max_eddy_dissipation_time_scale, & 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 @@ -605,6 +616,8 @@ 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 @@ -619,7 +632,7 @@ subroutine tke_shear_prod(def2) real rdzw, wrku, wrkv, wrkw integer i,k,k1 - + ! Calculate TKE shear production term at layer interface do k=2,nzm @@ -686,7 +699,7 @@ subroutine eddy_length() l_inf(i) = 100.0d0 endif enddo - + !Calculate length scale outside of cloud, Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) do k=1,nzm @@ -744,14 +757,14 @@ subroutine eddy_length() brunt(i,k) = betdz*(bbb*(hl(i,kc)-hl(i,kb)) & + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,k)) & - * (total_water(i,kc)-total_water(i,kb)) & + * (total_water(i,kc)-total_water(i,kb)) & + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) else ! outside of cloud ! Find outside-of-cloud Brunt-Vaisalla frequency -! Only unsaturated air, rain and snow contribute to virt. pot. temp. +! Only unsaturated air, rain and snow contribute to virt. pot. temp. ! liquid/ice moist static energy divided by cp? bbb = one + epsv*qv(i,k) - qpl(i,k) - qpi(i,k) @@ -760,16 +773,16 @@ subroutine eddy_length() + (bbb*fac_cond-tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + (bbb*fac_sub -tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) endif - + ! Reduction of mixing length in the stable regions (where B.-V. freq. > 0) is required. -! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. +! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. if (brunt(i,k) >= zero) then brunt2(i,k) = brunt(i,k) else brunt2(i,k) = zero endif - + ! Calculate turbulent length scale in the boundary layer. ! See Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -781,8 +794,8 @@ subroutine eddy_length() ! smixt(i,k) = term + (0.4*zl(i,k)-term)*exp(-zl(i,k)*0.01) ! else -! tscale is the eddy turnover time scale in the boundary layer and is -! an empirically derived constant +! tscale is the eddy turnover time scale in the boundary layer and is +! an empirically derived constant if (tkes > zero .and. l_inf(i) > zero) then wrk1 = one / (tscale*tkes*vonk*zl(i,k)) @@ -792,19 +805,19 @@ subroutine eddy_length() ! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) smixt(i,k) = min(max_eddy_length_scale, wrk1) -! smixt(i,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,k))) & +! smixt(i,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,k))) & ! + (1./(tscale*tkes*l_inf(i)))+0.01*(brunt2(i,k)/tke(i,k)))))/0.3) ! else ! smixt(i,k) = zero endif - + ! endif - - + + enddo enddo - - + + ! Now find the in-cloud turbulence length scale ! See Eq. 13 in BK13 (Eq. 4.18 in Pete's disseration) @@ -812,7 +825,7 @@ subroutine eddy_length() ! Remove after coupling to subgrid PDF. !wthv_sec = -300/ggr*brunt*tk !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - + ! determine cubed convective velocity scale (conv_vel2) inside the cloud ! call conv_scale() ! inlining the relevant code @@ -863,12 +876,11 @@ subroutine eddy_length() conv_var = conv_var+ 2.5d0*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) enddo conv_var = conv_var ** oneb3 - + if (conv_var > 0) then ! If convective vertical velocity scale > 0 depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) - - + do kk=kl,ku ! in-cloud turbulence length scale, Eq. 13 in BK13 (Eq. 4.18) @@ -890,14 +902,14 @@ subroutine eddy_length() enddo ! k=2,nzm-3 endif ! if in the cloudy column enddo ! i=1,nx - - + + end subroutine eddy_length subroutine conv_scale() -! This subroutine calculates the cubed convective velocity scale needed +! This subroutine calculates the cubed convective velocity scale needed ! for the definition of the length scale in clouds ! See Eq. 16 in BK13 (Eq. 4.21 in Pete's dissertation) @@ -908,7 +920,7 @@ subroutine conv_scale() ! Obtain it by averaging conv_vel2 in the horizontal !!!!!!!!!! -! conv_vel(1)=zero ! Horizontally averaged convective velocity scale cubed +! conv_vel(1)=zero ! Horizontally averaged convective velocity scale cubed do i=1,nx conv_vel2(i,1) = zero ! Convective velocity scale cubed enddo @@ -917,10 +929,10 @@ subroutine conv_scale() ! conv_vel(k)=conv_vel(k-1) do i=1,nx !********************************************************************** -!Do not include grid-scale contribution to convective velocity scale in GCM applications +!Do not include grid-scale contribution to convective velocity scale in GCM applications ! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) ! conv_vel(k)=conv_vel(k)+2.5*adzi(i,k)*bet(i,k)*(tvws(k)) -!Do not include grid-scale contribution to convective velocity scale in GCM applications +!Do not include grid-scale contribution to convective velocity scale in GCM applications ! conv_vel2(i,k)=conv_vel2(i,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,k)) !********************************************************************** @@ -934,7 +946,7 @@ end subroutine conv_scale subroutine check_eddy() -! This subroutine checks eddy length values +! This subroutine checks eddy length values integer i, k, kb, ks, zend real wrk @@ -958,11 +970,11 @@ subroutine check_eddy() wrk = 0.1*adzl(i,k) ! Minimum 0.1 of local dz - smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) + smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) ! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to -! be not larger that that. -! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) +! be not larger that that. +! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) if (qcl(i,kb) == 0 .and. qcl(i,k) > 0 .and. brunt(i,k) > 1.0d-4) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz @@ -980,21 +992,21 @@ subroutine canuto() ! based on Canuto et at, 2001, JAS, 58, 1169-1172 (further referred to as C01) ! This allows to avoid having a prognostic equation for the third moment. ! Result is returned in a global variable w3 defined at the interface levels. - + ! Local variables integer i, k, kb, kc real bet2, f0, f1, f2, f3, f4, f5, iso, isosqr, & omega0, omega1, omega2, X0, Y0, X1, Y1, AA0, AA1, buoy_sgs2, & -! wrk, wrk1, wrk2, wrk3, avew - cond_w, wrk, wrk1, wrk2, wrk3, avew + wrk, wrk1, wrk2, wrk3, avew +! cond_w, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) real, parameter :: c=7.0d0, a0=0.52d0/(c*c*(c-2.0d0)), a1=0.87d0/(c*c), & a2=0.5d0/c, a3=0.6d0/(c*(c-2.0d0)), a4=2.4d0/(3.0d0*c+5.0d0), & a5=0.6d0/(c*(3.0d0*c+5.0d0)) !Moorthi a5=0.6d0/(c*(3.0d0+5.0d0*c)) - + ! do k=1,nzm do k=2,nzm @@ -1041,8 +1053,7 @@ subroutine canuto() ! This is not a bug, but an algorithmical change. ! The line below calculates cond_w ,an estimate of the maximum allowed value of the third moment. ! It is used at the end of this subroutine to limit the value of w3. -! Here the second moment is interpolated from the layer centers to the interface, where w3 is -! defined. +! Here the second moment is interpolated from the layer centers to the interface, where w3 is defined. ! 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 @@ -1147,16 +1158,16 @@ subroutine assumed_pdf() wqisb(k) = zero enddo - + DO k=1,nzm - + kd = k ku = k + 1 ! if (k == nzm) ku = k - + DO i=1,nx -! Initialize cloud variables to zero +! Initialize cloud variables to zero diag_qn = zero diag_frac = zero diag_ql = zero @@ -1172,8 +1183,8 @@ subroutine assumed_pdf() qw_first = total_water(i,k) ! w_first = half*(w(i,kd)+w(i,ku)) w_first = w(i,k) - - + + ! GET ALL INPUT VARIABLES ON THE SAME GRID ! Points to be computed with relation to thermo point ! Read in points that need to be averaged @@ -1218,7 +1229,7 @@ subroutine assumed_pdf() else sqrtqt = zero endif - + ! Find parameters of the double Gaussian PDF of vertical velocity @@ -1256,7 +1267,7 @@ subroutine assumed_pdf() onema = one - aterm sqrtw2t = sqrt(wrk) - + ! Eq. A.5-A.6 wrk = sqrt(onema/aterm) w1_1 = sqrtw2t * wrk @@ -1266,7 +1277,7 @@ subroutine assumed_pdf() w2_2 = w2_2 * w_sec(i,k) ENDIF - + ! Find parameters of the PDF of liquid/ice static energy ! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& @@ -1284,7 +1295,7 @@ subroutine assumed_pdf() thl1_1 = -corrtest1 / w1_2 ! A.7 thl1_2 = -corrtest1 / w1_1 ! A.8 - + wrk1 = thl1_1 * thl1_1 wrk2 = thl1_2 * thl1_2 wrk3 = three * (one - aterm*wrk1 - onema*wrk2) @@ -1329,8 +1340,11 @@ subroutine assumed_pdf() qw1_1 = - corrtest2 / w1_2 ! A.7 qw1_2 = - corrtest2 / w1_1 ! A.8 +! if (lprnt .and. i == ipr .and. k<40) 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 IF (tsign > 0.4) THEN @@ -1398,6 +1412,7 @@ 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 @@ -1422,9 +1437,9 @@ subroutine assumed_pdf() ! Are the two plumes equal? If so then set qs and beta ! in each column to each other to save computation IF (Tl1_1 == Tl1_2) THEN - qs2 = qs1 + qs2 = qs1 beta2 = beta1 - ELSE + ELSE IF (Tl1_2 >= tbgmax) THEN lstarn2 = lcond esval = min(fpvsl(Tl1_2), pval) @@ -1441,14 +1456,14 @@ subroutine assumed_pdf() qs2 = om2 * eps * esval / (pval-0.378d0*esval) & + (one-om2) * epss * esval2 / (pval-0.378d0*esval2) ENDIF - + ! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 ! beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 beta2 = lstarn2 / Tl1_2 beta2 = beta2 * beta2 * onebrvcp - + ENDIF qs1 = qs1 * rhc(i,k) @@ -1461,6 +1476,9 @@ 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)) @@ -1474,7 +1492,7 @@ 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=','std=',std_s1,& +! 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 @@ -1552,7 +1570,7 @@ 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,1,k),' k=',k& +! 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 @@ -1579,9 +1597,8 @@ subroutine assumed_pdf() ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0d0), nmin) endif endif - - + ! Compute the liquid water flux wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) @@ -1589,7 +1606,7 @@ subroutine assumed_pdf() ! Compute statistics for the fluxes so we don't have to save these variables wqlsb(k) = wqlsb(k) + wqls wqisb(k) = wqisb(k) + wqis - + ! diagnostic buoyancy flux. Includes effects from liquid water, ice ! condensate, liquid & ice precipitation ! wrk = epsv * basetemp diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 75618400e..e3666c26a 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -57,7 +57,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi - real(kind=kind_phys) :: sig1t + real(kind=kind_phys) :: sig1t, dt_warm integer :: npts, len, nb, ix, jx, ls, ios logical :: exists ! @@ -184,15 +184,22 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) close (Model%nlunit) #endif - len = 0 + len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then - Sfcprop(nb)%tref(ix) = TSFFCS (len) + Sfcprop(nb)%tref(ix) = TSFFCS (len) +! if (Model%nstf_name(2) == 0) then +! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & +! / Sfcprop(nb)%xz(ix) +! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & +! + dt_warm - Sfcprop(nb)%dt_cool(ix) +! endif else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) @@ -233,6 +240,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! call mymaxmin(slifcs,len,len,1,'slifcs') ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour - + RETURN END diff --git a/gfsphysics/physics/gwdps.f b/gfsphysics/physics/gwdps.f index 18385d596..433c9101e 100644 --- a/gfsphysics/physics/gwdps.f +++ b/gfsphysics/physics/gwdps.f @@ -587,10 +587,10 @@ SUBROUTINE GWDPS(IM,IX,IY,KM,A,B,C,U1,V1,T1,Q1,KPBL, & ! do i=1,npt iwklm(i) = 2 - IDXZB(i) = 0 + IDXZB(i) = 0 ! kreflm(i) = 0 enddo -! if (lprnt) +! if (lprnt) ! & print *,' in gwdps_lm.f npt,IM,IX,IY,km,me=',npt,IM,IX,IY,km,me ! ! @@ -680,7 +680,7 @@ SUBROUTINE GWDPS(IM,IX,IY,KM,A,B,C,U1,V1,T1,Q1,KPBL, & BNV2bar(I) = (PRSI(J,1)-PRSL(J,1)) * DELKS(I) * BNV2LM(I,1) ENDDO -! --- find the dividing stream line height +! --- find the dividing stream line height ! --- starting from the level above the max mtn downward ! --- iwklm(i) is the k-index of mtn elvmax elevation !> - Find the dividing streamline height starting from the level above @@ -698,14 +698,14 @@ SUBROUTINE GWDPS(IM,IX,IY,KM,A,B,C,U1,V1,T1,Q1,KPBL, & ! --- make averages, guess dividing stream (DS) line layer. ! --- This is not used in the first cut except for testing and ! --- is the vert ave of quantities from the surface to mtn top. -! +! DO I = 1, npt DO K = 1, iwklm(i)-1 J = ipt(i) RDELKS = DEL(J,K) * DELKS(I) - UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below - VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below - ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below if (k < iwklm(I)-1) then RDELKS = (PRSL(J,K)-PRSL(J,K+1)) * DELKS(I) else @@ -718,7 +718,7 @@ SUBROUTINE GWDPS(IM,IX,IY,KM,A,B,C,U1,V1,T1,Q1,KPBL, & ! print *,' in gwdps_lm.f 5 =',i,kreflm(npt),BNV2bar(npt),me ! ! --- integrate to get PE in the trial layer. -! --- Need the first layer where PE>EK - as soon as +! --- Need the first layer where PE>EK - as soon as ! --- IDXZB is not 0 we have a hit and Zb is found. ! DO I = 1, npt @@ -976,13 +976,13 @@ SUBROUTINE GWDPS(IM,IX,IY,KM,A,B,C,U1,V1,T1,Q1,KPBL, & enddo enddo ! -!> - Calculate the reference level index: kref=max(2,KPBL+1). where +!> - Calculate the reference level index: kref=max(2,KPBL+1). where !! KPBL is the index for the PBL top layer. KBPS = 1 KMPS = KM DO I=1,npt J = ipt(i) - kref(I) = MAX(IWK(I), KPBL(J)+1 ) ! reference level + kref(I) = MAX(IWK(I), KPBL(J)+1 ) ! reference level DELKS(I) = 1.0 / (PRSI(J,1) - PRSI(J,kref(I))) ! DELKS1(I) = 1.0 / (PRSI(J,1) - PRSL(J,kref(I))) UBAR (I) = 0.0 diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 9d4d3a318..26a04d96a 100644 --- a/gfsphysics/physics/m_micro_driver.F90 +++ b/gfsphysics/physics/m_micro_driver.F90 @@ -3,7 +3,6 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & &, omega_i, QLLS_i, QLCN_i, QILS_i, QICN_i& &, lwheat_i, swheat_i, w_upi, cf_upi & &, FRLAND, ZPBL, CNV_MFD_i & -! &, FRLAND, ZPBL, CNV_MFD_i, CNV_PRC3_i & &, CNV_DQLDT_i, CLCN_i, u_i, v_i & &, TAUGWX, TAUGWY, TAUX, TAUY & &, TAUOROX, TAUOROY, CNV_FICE_i & @@ -16,7 +15,6 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & &, CLDREFFG, aerfld_i & &, aero_in, naai_i, npccn_i, iccn & &, skip_macro & -! &, skip_macro, cn_prc2, cn_snr & &, lprnt, alf_fac, qc_min, pdfflag & &, ipr, kdt, xlat, xlon, rhc_i) @@ -73,20 +71,20 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & real (kind=kind_phys), dimension(im,lm),intent(in) :: & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & -! & CNV_MFD_i, CNV_PRC3_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & & CNV_NICE_i, w_upi, rhc_i, naai_i, npccn_i real (kind=kind_phys), dimension(im,lm,ntrcaer),intent(in) :: & & aerfld_i real (kind=kind_phys),dimension(im),intent(in):: TAUGWX, & & TAUGWY, TAUX, TAUY, TAUOROX, TAUOROY, FRLAND,ZPBL,xlat,xlon -! & TAUGWY, TAUX, TAUY, TAUOROX, TAUOROY,ps_i,FRLAND,ZPBL -! & CNVPRCP ! output real (kind=kind_phys),dimension(ix,lm) :: lwm_o, qi_o, & cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(im) :: rn_o, sr_o +! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose + integer, dimension(IM) :: KCBL + ! input and output real (kind=kind_phys),dimension(ix,lm),intent(inout):: q_io, t_io, & & ncpl_io,ncpi_io,CLLS_io @@ -170,8 +168,6 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! & LS_SNR, LS_PRC2, TPREC real(kind=kind_phys), dimension(IM) :: LS_SNR, LS_PRC2 ! & VMIP, twat -! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose - integer, dimension(IM) :: KCBL real(kind=kind_phys), dimension (LM) :: uwind_gw,vwind_gw, & & tm_gw, pm_gw, nm_gw, h_gw, rho_gw, khaux, qcaux, & @@ -393,6 +389,13 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & enddo endif endif + +! if (lprnt) then +! write(0,*)' inmic qlcn=',qlcn(ipr,:) +! write(0,*)' inmic qlls=',qlls(ipr,:) +! write(0,*)' inmic qicn=',qicn(ipr,:) +! write(0,*)' inmic qils=',qils(ipr,:) +! endif ! DT_MOIST = dt_i dt_r8 = dt_i @@ -405,12 +408,12 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) if (rnw(i,k) <= qc_min(1)) then - ncpl(i,k) = 0.0 - elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = 0.0 + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = 0.0 elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) endif @@ -1399,7 +1402,9 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! if(lprint) then ! write(0,*)' calling micro_mg_tend3_0 qcvar3=',qcvar3,' i=',i ! write(0,*)' qcr8=',qcr8(:) +! write(0,*)' qir8=',qir8(:) ! write(0,*)' ncr8=',ncr8(:) +! write(0,*)' nir8=',nir8(:) ! write(0,*)' npccninr8=',npccninr8(:) ! write(0,*)' plevr8=',plevr8(:) ! write(0,*)' ter8=',ter8(:) @@ -1535,10 +1540,18 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & if (skip_macro) then do k=1,lm do i=1,im + QLCN(i,k) = QL_TOT(i,k) * FQA(i,k) + QLLS(i,k) = QL_TOT(i,k) - QLCN(i,k) + QICN(i,k) = QI_TOT(i,k) * FQA(i,k) + QILS(i,k) = QI_TOT(i,k) - QICN(i,k) + CALL fix_up_clouds_2M(Q1(I,K), TEMP(i,k), QLLS(I,K), & & QILS(I,K), CLLS(I,K), QLCN(I,K), & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) + + QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) + QI_TOT(I,K) = QILS(I,K) + QICN(I,K) if (rnw(i,k) <= qc_min(1)) then ncpl(i,k) = 0.0 elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 @@ -1695,7 +1708,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & if (allocated(ALPHT_X)) deallocate (ALPHT_X) ! if (lprnt) then -! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr) +! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr),' kdt=',kdt ! write(0,*)' end micro_mg_tend t_io= ', t_io(ipr,:) ! write(0,*)' end micro_mg_tend clls_io= ', clls_io(ipr,:) ! endif diff --git a/gfsphysics/physics/micro_mg2_0.F90 b/gfsphysics/physics/micro_mg2_0.F90 index 325a2dbbe..281802878 100644 --- a/gfsphysics/physics/micro_mg2_0.F90 +++ b/gfsphysics/physics/micro_mg2_0.F90 @@ -1,44 +1,27 @@ +!>\file micro_mg2_0.F90 +!! This file contains Morrison-Gettelman MP version 2.0 - update of MG +!! microphysics with prognostic precipitation. + +!>\ingroup mg2mg3 +!>\defgroup mg2_0_mp Morrison-Gettelman MP version 2.0 +!! This module includes the MG microphysics version 2.0 - update of MG +!! microphysics with prognostic precipitation. +!! +!!\author Andrew Gettelman, Hugh Morrison, Sean Santos +!! e-mail: morrison@ucar.edu, andrew@ucar.edu +!!\n Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +!! +!! - Anning Cheng adopted for FV3GFS 9/29/2017 +!! - Anning Cheng added GMAO ice conversion and Liu et al. Liquid water conversion +!! in 10/12/2017 +!! - S. Moorthi - Oct/Nov 2017 - optimized the code +!! - S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit +!! - Version 2 history: +!! - Sep 2011: Development begun +!! - Feb 2013: Added of prognostic precipitation +!! - Aug 2015: Published and released version (\cite Gettelman_2015_1 \cite Gettelman_2015_2 ) module micro_mg2_0 !--------------------------------------------------------------------------------- -! Purpose: -! MG microphysics version 2.0 - Update of MG microphysics with -! prognostic precipitation. -! -! Author: Andrew Gettelman, Hugh Morrison, Sean Santos -! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan -! Anning Cheng adopted for FV3GFS 9/29/2017 -! add GMAO ice conversion and Liu et. al liquid water -! conversion in 10/12/2017 -! Anning showed promising results for FV3GFS on 10/15/2017 -! S. Moorthi - Oct/Nov 2017 - optimized the code -! S. Moorthi - Nov 2017 - made the sedimentation quasi-implicit -! Version 2 history: Sep 2011: Development begun. -! Feb 2013: Added of prognostic precipitation. -! Aug 2015: Published and released version -! -! invoked in CAM by specifying -microphys=mg2.0 -! -! References: -! -! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models. -! -! Part I: Off line tests and comparisons with other schemes. -! -! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015. -! -! -! -! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell -! -! Advanced Two-Moment Microphysics for Global Models. -! -! Part II: Global model solutions and Aerosol-Cloud Interactions. -! -! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. -! -! for questions contact Hugh Morrison, Andrew Gettelman -! e-mail: morrison@ucar.edu, andrew@ucar.edu -!--------------------------------------------------------------------------------- ! ! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice ! microphysics in cooperation with the MG liquid microphysics. This is @@ -214,6 +197,8 @@ module micro_mg2_0 contains !=============================================================================== +!>\ingroup mg2_0_mp +!! This subroutine calculates subroutine micro_mg_init( & kind, gravit, rair, rh2o, cpair, & tmelt_in, latvap, latice, & @@ -236,29 +221,29 @@ subroutine micro_mg_init( & ! !----------------------------------------------------------------------- - integer, intent(in) :: kind ! Kind used for reals + integer, intent(in) :: kind !< Kind used for reals real(r8), intent(in) :: gravit real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair - real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) + real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice - real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0. + real(r8), intent(in) :: rhmini_in !< Minimum rh for ice cloud fraction > 0. real(r8), intent(in) :: micro_mg_dcs real(r8), intent(in) :: ts_auto(2) real(r8), intent(in) :: mg_qcvar - logical, intent(in) :: microp_uniform_in ! .true. = configure uniform for sub-columns - ! .false. = use w/o sub-columns (standard) - logical, intent(in) :: do_cldice_in ! .true. = do all processes (standard) - ! .false. = skip all processes affecting cloud ice - logical, intent(in) :: use_hetfrz_classnuc_in ! use heterogeneous freezing + logical, intent(in) :: microp_uniform_in !< .true. = configure uniform for sub-columns + !! .false. = use w/o sub-columns (standard) + logical, intent(in) :: do_cldice_in !< .true. = do all processes (standard) + !! .false. = skip all processes affecting cloud ice + logical, intent(in) :: use_hetfrz_classnuc_in !< use heterogeneous freezing - character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method - real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor - logical, intent(in) :: allow_sed_supersat_in ! allow supersaturated conditions after sedimentation loop - logical, intent(in) :: do_sb_physics_in ! do SB autoconversion and accretion physics + character(len=16),intent(in) :: micro_mg_precip_frac_method_in !< type of precipitation fraction method + real(r8), intent(in) :: micro_mg_berg_eff_factor_in !< berg efficiency factor + logical, intent(in) :: allow_sed_supersat_in !< allow supersaturated conditions after sedimentation loop + logical, intent(in) :: do_sb_physics_in !< do SB autoconversion and accretion physics logical, intent(in) :: do_ice_gmao_in logical, intent(in) :: do_liq_liu_in @@ -351,6 +336,11 @@ end subroutine micro_mg_init !=============================================================================== !microphysics routine for each timestep goes here... +!\ingroup mg2_0_mp +!> This subroutine is the main microphysics routine to be called each time step +!! +!! this also calls several smaller subroutines to calculate +!! microphysical processes and other utilities subroutine micro_mg_tend ( & mgncol, nlev, deltatin, & t, q, & @@ -3354,6 +3344,8 @@ end subroutine micro_mg_tend !OUTPUT CALCULATIONS !======================================================================== +!>\ingroup mg2_0_mp +!! This subroutine subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) integer, intent(in) :: mgncol, nlev real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) diff --git a/gfsphysics/physics/micro_mg3_0.F90 b/gfsphysics/physics/micro_mg3_0.F90 index cbd25370a..f27aa1896 100644 --- a/gfsphysics/physics/micro_mg3_0.F90 +++ b/gfsphysics/physics/micro_mg3_0.F90 @@ -1601,7 +1601,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = tlat(i,k) + dum1 meltsdttot(i,k) = meltsdttot(i,k) + dum1 -! if (lprnt .and. k >=100) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& ! ' minstsm=',minstsm(i,k),' qs=',qs(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' dum=',dum,' k=',k @@ -1643,7 +1643,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = dum1 + tlat(i,k) meltsdttot(i,k) = dum1 + meltsdttot(i,k) -! if (lprnt .and. k >=100) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& ! ' minstgm=',minstgm(i,k),' qg=',qg(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' k=',k,' cpp=',cpp @@ -2171,6 +2171,10 @@ subroutine micro_mg_tend ( & call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & qvl(:,k), qvi(:,k), asn(:,k), qcic(:,k), qsic(:,k), lams(:,k), n0s(:,k), & bergs(:,k), mgncol) +! if(lprnt) write(0,*)' bergs1=',bergs(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor +! if(lprnt) write(0,*)' t=',t(1,k),' rho=',rho(1,k),' dv=',dv(1,k),' mu=',mu(1,k),& +! 'qcic=',qcic(1,k),' qsic=',qsic(1,k),' qvl=',qvl(1,k),' qvi=',qvi(1,k), & +! ' mu=',mu(1,k),' sc=',sc(1,k),' asn=',asn(1,k),' lams=',lams(1,k),' n0s=',n0s(1,k) bergs(:,k) = bergs(:,k) * micro_mg_berg_eff_factor @@ -2181,6 +2185,11 @@ subroutine micro_mg_tend ( & icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) +! if(lprnt) write(0,*)' t=',t(1,k),' k=',k,' q=',q(1,k),' qi=',qi(1,k),& +! ' ni=',ni(1,k),' icldm=',icldm(1,k),' rho=',rho(1,k),' dv=',dv(1,k),& +! ' qvl=',qvl(1,k),' qvi=',qvi(1,k),' berg=',berg(1,k),' vap_dep=',& +! vap_dep(1,k),' ice_sublim=',ice_sublim(1,k) +! if(lprnt) write(0,*)' berg1=',berg(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor do i=1,mgncol ! sublimation should not exceed available ice ice_sublim(i,k) = max(ice_sublim(i,k), -qi(i,k)*oneodt) @@ -2356,6 +2365,8 @@ subroutine micro_mg_tend ( & qcrat(i,k) = one end if +! if(lprnt) write(0,*)' bergs2=',bergs(1,k),' k=',k,' ratio=',ratio + !PMC 12/3/12: ratio is also frac of step w/ liquid. !thus we apply berg for "ratio" of timestep and vapor !deposition for the remaining frac of the timestep. @@ -2827,11 +2838,11 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' k=',k,' tlat=',tlat(i,k) ! if (lprnt .and. k >= 60) write(0,*)' k=',k,' tlat=',tlat(i,k) -! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & -! psacws(i,k)-bergs(i,k))*l!ldm(i,k)-berg(i,k) +! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & +! psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) - qctend(i,k) = qctend(i,k)+ & - (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + qctend(i,k) = qctend(i,k) + & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k) - & psacws(i,k)-bergs(i,k)-qmultg(i,k)-psacwg(i,k)-pgsacw(i,k))*lcldm(i,k)-berg(i,k) if (do_cldice) then @@ -3669,7 +3680,7 @@ subroutine micro_mg_tend ( & end do !! nstep loop ! if (lprnt) write(0,*)' prectaftssno=',prect(i),' preci=',preci(i) -! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) +! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) if (do_graupel .or. do_hail) then !++ag Graupel Sedimentation diff --git a/gfsphysics/physics/micro_mg_utils.F90 b/gfsphysics/physics/micro_mg_utils.F90 index e50420270..ab20ec7cf 100644 --- a/gfsphysics/physics/micro_mg_utils.F90 +++ b/gfsphysics/physics/micro_mg_utils.F90 @@ -1,24 +1,30 @@ +!>\file micro_mg_utils.F90 +!! This file contains process rates and utility functions used by the +!! MG microphysics. + +!>\ingroup mg2mg3 +!>\defgroup micro_mg_utils_mod Morrison-Gettelman MP utils Module +!! This module contains process rates and utility functions used by the MG +!! microphysics. +!! +!! Original MG authors: Andrew Gettelman, Hugh Morrison +!! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +!! +!! Separated from MG 1.5 by B. Eaton. +!! +!! Separated module switched to MG 2.0 and further changes by S. Santos. +!! +!! Anning Cheng changed for FV3GFS 9/29/2017 +!! added ac_time as an input +!! +!! S. Moorthi - Feb 2018 : code optimization +!! +!! This version: https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ +!! +!! for questions contact Hugh Morrison, Andrew Gettelman +!! e-mail: morrison@ucar.edu, andrew@ucar.edu module micro_mg_utils -!-------------------------------------------------------------------------- -! -! This module contains process rates and utility functions used by the MG -! microphysics. -! -! Original MG authors: Andrew Gettelman, Hugh Morrison -! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan -! -! Separated from MG 1.5 by B. Eaton. -! Separated module switched to MG 2.0 and further changes by S. Santos. -! Anning Cheng changed for FV3GFS 9/29/2017 -! added ac_time as an input -! S. Moorthi - Feb 2018 : code optimization -! -! This version: https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/mg3_tags/mg3_33_cam5_4_153/ -! -! for questions contact Hugh Morrison, Andrew Gettelman -! e-mail: morrison@ucar.edu, andrew@ucar.edu -! !-------------------------------------------------------------------------- ! ! List of required external functions that must be supplied: @@ -132,25 +138,25 @@ module micro_mg_utils ! Public module parameters (mostly for MG itself) !================================================= -! Pi to 20 digits; more than enough to reach the limit of double precision. +!> Pi to 20 digits; more than enough to reach the limit of double precision. real(r8), parameter, public :: pi = 3.14159265358979323846_r8 -! "One minus small number": number near unity for round-off issues. +!> "One minus small number": number near unity for round-off issues. !real(r8), parameter, public :: omsm = 1._r8 - 1.e-5_r8 real(r8), parameter, public :: omsm = 1._r8 - 1.e-6_r8 -! Smallest mixing ratio considered in microphysics. +!> Smallest mixing ratio considered in microphysics. real(r8), parameter, public :: qsmall = 1.e-18_r8 -! minimum allowed cloud fraction +!> minimum allowed cloud fraction real(r8), parameter, public :: mincld = 0.000001_r8 !real(r8), parameter, public :: mincld = 0.0001_r8 !real(r8), parameter, public :: mincld = 0.0_r8 -real(r8), parameter, public :: rhosn = 250._r8 ! bulk density snow -real(r8), parameter, public :: rhoi = 500._r8 ! bulk density ice -real(r8), parameter, public :: rhow = 1000._r8 ! bulk density liquid -real(r8), parameter, public :: rhows = 917._r8 ! bulk density water solid +real(r8), parameter, public :: rhosn = 250._r8 !< bulk density snow +real(r8), parameter, public :: rhoi = 500._r8 !< bulk density ice +real(r8), parameter, public :: rhow = 1000._r8 !< bulk density liquid +real(r8), parameter, public :: rhows = 917._r8 !< bulk density water solid !++ag !Hail and Graupel (set in MG3) @@ -183,9 +189,9 @@ module micro_mg_utils real(r8), parameter, public :: bh = 0.5_r8 !--ag -! mass of new crystal due to aerosol freezing and growth (kg) -! Make this consistent with the lower bound, to support UTLS and -! stratospheric ice, and the smaller ice size limit. +!> mass of new crystal due to aerosol freezing and growth (kg) +!! Make this consistent with the lower bound, to support UTLS and +!! stratospheric ice, and the smaller ice size limit. real(r8), parameter, public :: mi0 = 4._r8/3._r8*pi*rhoi*(1.e-6_r8)**3 !++ag @@ -284,11 +290,13 @@ module micro_mg_utils ! some argument is an integer. !========================================================= +!>\ingroup micro_mg_utils_mod interface rising_factorial module procedure rising_factorial_r8 module procedure rising_factorial_integer end interface rising_factorial +!>\ingroup micro_mg_utils_mod interface var_coef module procedure var_coef_r8 module procedure var_coef_integer @@ -298,7 +306,8 @@ module micro_mg_utils contains !========================================================================== -! Initialize module variables. +!>\ingroup micro_mg_utils_mod +!! Initialize module variables. ! ! "kind" serves no purpose here except to check for unlikely linking ! issues; always pass in the kind for a double precision real. @@ -372,7 +381,8 @@ subroutine micro_mg_utils_init( kind, rair, rh2o, cpair, tmelt_in, latvap, & end subroutine micro_mg_utils_init -! Constructor for a constituent property object. +!>\ingroup micro_mg_utils_mod +!! Constructor for a constituent property object. function NewMGHydrometeorProps(rho, eff_dim, lambda_bounds, min_mean_mass) & result(res) real(r8), intent(in) :: rho, eff_dim @@ -443,7 +453,8 @@ elemental function calc_ab(t, qv, xxl) result(ab) end function calc_ab -! get cloud droplet size distribution parameters +!>\ingroup micro_mg_utils_mod +!! get cloud droplet size distribution parameters elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc) type(MGHydrometeorProps), intent(in) :: props real(r8), intent(in) :: qcic @@ -512,8 +523,8 @@ elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc end subroutine size_dist_param_liq_line -! get cloud droplet size distribution parameters - +!>\ingroup micro_mg_utils_mod +!! This subroutine gets cloud droplet size distribution parameters subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) type(mghydrometeorprops), intent(in) :: props @@ -587,7 +598,8 @@ subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) end subroutine size_dist_param_liq_vect -! Basic routine for getting size distribution parameters. +!>\ingroup micro_mg_utils_mod +!! Basic routine for getting size distribution parameters. elemental subroutine size_dist_param_basic_line(props, qic, nic, lam, n0) type(MGHydrometeorProps), intent(in) :: props real(r8), intent(in) :: qic @@ -625,6 +637,8 @@ elemental subroutine size_dist_param_basic_line(props, qic, nic, lam, n0) end subroutine size_dist_param_basic_line +!>\ingroup micro_mg_utils_mod +!! This subroutine calculates subroutine size_dist_param_basic_vect(props, qic, nic, lam, mgncol, n0) type (mghydrometeorprops), intent(in) :: props @@ -667,7 +681,8 @@ subroutine size_dist_param_basic_vect(props, qic, nic, lam, mgncol, n0) end subroutine size_dist_param_basic_vect -! ice routine for getting size distribution parameters. +!>\ingroup micro_mg_utils_mod +!! ice routine for getting size distribution parameters. elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) type(MGHydrometeorProps), intent(in) :: props real(r8), intent(in) :: qic @@ -720,6 +735,8 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) end subroutine size_dist_param_ice_line +!>\ingroup micro_mg_utils_mod +!! This subroutine subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) type (mghydrometeorprops), intent(in) :: props @@ -776,23 +793,24 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) end subroutine size_dist_param_ice_vect - +!>\ingroup micro_mg_utils_mod +!> Finds the average diameter of particles given their density, and +!! mass/number concentrations in the air. +!! Assumes that diameter follows an exponential distribution. real(r8) elemental function avg_diameter(q, n, rho_air, rho_sub) - ! Finds the average diameter of particles given their density, and - ! mass/number concentrations in the air. - ! Assumes that diameter follows an exponential distribution. - real(r8), intent(in) :: q ! mass mixing ratio - real(r8), intent(in) :: n ! number concentration (per volume) - real(r8), intent(in) :: rho_air ! local density of the air - real(r8), intent(in) :: rho_sub ! density of the particle substance + real(r8), intent(in) :: q !< mass mixing ratio + real(r8), intent(in) :: n !< number concentration (per volume) + real(r8), intent(in) :: rho_air !< local density of the air + real(r8), intent(in) :: rho_sub !< density of the particle substance avg_diameter = (pi * rho_sub * n/(q*rho_air))**(-oneo3) end function avg_diameter +!>\ingroup mg2mg3 +!> Finds a coefficient for process rates based on the relative variance +!! of cloud water. elemental function var_coef_r8(relvar, a) result(res) - ! Finds a coefficient for process rates based on the relative variance - ! of cloud water. real(r8), intent(in) :: relvar real(r8), intent(in) :: a real(r8) :: res @@ -801,9 +819,10 @@ elemental function var_coef_r8(relvar, a) result(res) end function var_coef_r8 +!>\ingroup mg2mg3 +!> Finds a coefficient for process rates based on the relative variance +!! of cloud water. elemental function var_coef_integer(relvar, a) result(res) - ! Finds a coefficient for process rates based on the relative variance - ! of cloud water. real(r8), intent(in) :: relvar integer, intent(in) :: a real(r8) :: res @@ -816,16 +835,17 @@ end function var_coef_integer !MICROPHYSICAL PROCESS CALCULATIONS !======================================================================== !======================================================================== -! Initial ice deposition and sublimation loop. -! Run before the main loop -! This subroutine written by Peter Caldwell - -subroutine ice_deposition_sublimation(t, qv, qi, ni, & +!>\ingroup micro_mg_utils_mod +!! Initial ice deposition and sublimation loop. +!! Run before the main loop +!! This subroutine written by Peter Caldwell +subroutine ice_deposition_sublimation(t, qv, qi, ni, & icldm, rho, dv,qvl, qvi, & berg, vap_dep, ice_sublim, mgncol) !INPUT VARS: !=============================================== +! logical, intent(in) :: lprnt integer, intent(in) :: mgncol real(r8), dimension(mgncol), intent(in) :: t real(r8), dimension(mgncol), intent(in) :: qv @@ -869,6 +889,9 @@ subroutine ice_deposition_sublimation(t, qv, qi, ni, & ! call size_dist_param_basic(mg_ice_props, qiic, niic, lami, n0i) call size_dist_param_ice(mg_ice_props, qiic, niic, lami, n0i) !Get depletion timescale=1/eps +! if(lprnt) write(0,*)' twopi=',twopi,' n0i=',n0i,' rho=',rho(1),& +! ' dv=',dv(1),' lami=',lami,' mg_ice_props=',mg_ice_props,& +! ' qiic=',qiic,'niic=',niic epsi = twopi*n0i*rho(i)*Dv(i)/(lami*lami) !Compute deposition/sublimation @@ -886,6 +909,9 @@ subroutine ice_deposition_sublimation(t, qv, qi, ni, & vap_dep(i) = zero end if +! if (lprnt) write(0,*)' t=',t(1),' tmelt=',tmelt,' epsi=',epsi,' ab=',ab,& +! ' ice_sublim=',ice_sublim(1),' vap_dep=',vap_dep(1),' qvl=',qvl(1),qvi(1) + !sublimation occurs @ any T. Not so for berg. if (t(i) < tmelt) then @@ -904,10 +930,10 @@ subroutine ice_deposition_sublimation(t, qv, qi, ni, & end subroutine ice_deposition_sublimation !======================================================================== -! autoconversion of cloud liquid water to rain -! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc -! minimum qc of 1 x 10^-8 prevents floating point error - +!>\ingroup micro_mg_utils_mod +!! autoconversion of cloud liquid water to rain +!! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc +!! minimum qc of 1 x 10^-8 prevents floating point error subroutine kk2000_liq_autoconversion(microp_uniform, qcic, & ncic, rho, relvar, prc, nprc, nprc1, mgncol) @@ -958,6 +984,8 @@ subroutine kk2000_liq_autoconversion(microp_uniform, qcic, & end subroutine kk2000_liq_autoconversion !======================================================================== +!>\ingroup micro_mg_utils_mod +!! This subroutine subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mgncol) ! ! --------------------------------------------------------------------- @@ -1041,7 +1069,8 @@ subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mg end subroutine sb2001v2_liq_autoconversion !======================================================================== -! Anning Cheng 10/5/2017 add Liu et al. autoconversion +!>\ingroup micro_mg_utils_mod +!! Anning Cheng 10/5/2017 add Liu et al. autoconversion subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & au,nprc,nprc1,mgncol) @@ -1098,7 +1127,7 @@ end subroutine liu_liq_autoconversion !======================================================================== !SB2001 Accretion V2 - +!>\ingroup micro_mg_utils_mod subroutine sb2001v2_accre_cld_water_rain(qc,nc,qr,rho,relvar,pra,npra,mgncol) ! ! --------------------------------------------------------------------- @@ -1152,7 +1181,9 @@ end subroutine sb2001v2_accre_cld_water_rain !======================================================================== ! Autoconversion of cloud ice to snow ! similar to Ferrier (1994) - +!>\ingroup micro_mg_utils_mod +!! Autoconversion of cloud ice to snow +!! similar to Ferrier (1994) subroutine ice_autoconversion(t, qiic, lami, n0i, dcs, ac_time, prci, nprci, mgncol) integer, intent(in) :: mgncol @@ -1199,6 +1230,8 @@ subroutine ice_autoconversion(t, qiic, lami, n0i, dcs, ac_time, prci, nprci, mgn end subroutine ice_autoconversion !=================================== ! Anning Cheng 10/5/2017 added GMAO ice autoconversion +!>\ingroup micro_mg_utils_mod +!! GMAO ice autoconversion subroutine gmao_ice_autoconversion(t, qiic, niic, lami, n0i, & dcs, ac_time, prci, nprci, mgncol) @@ -1234,7 +1267,8 @@ end subroutine gmao_ice_autoconversion !=================================== ! immersion freezing (Bigg, 1953) !=================================== - +!>\ingroup micro_mg_utils_mod +!! immersion freezing (Bigg, 1953) subroutine immersion_freezing(microp_uniform, t, pgam, lamc, & qcic, ncic, relvar, mnuccc, nnuccc, mgncol) @@ -1288,10 +1322,9 @@ subroutine immersion_freezing(microp_uniform, t, pgam, lamc, & end subroutine immersion_freezing -! contact freezing (-40\ingroup micro_mg_utils_mod +!! contact freezing (-40\ingroup micro_mg_utils_mod +!! snow self-aggregation from passarelli, 1978, used by reisner, 1998 !=================================================================== ! this is hard-wired for bs = 0.4 for now ! ignore self-collection of cloud ice - subroutine snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg, mgncol) integer, intent(in) :: mgncol @@ -1410,13 +1443,13 @@ subroutine snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg, mgncol) enddo end subroutine snow_self_aggregation -! accretion of cloud droplets onto snow/graupel +!>\ingroup micro_mg_utils_mod +!! accretion of cloud droplets onto snow/graupel !=================================================================== ! here use continuous collection equation with ! simple gravitational collection kernel ! ignore collisions between droplets/cloud ice ! since minimum size ice particle for accretion is 50 - 150 micron - subroutine accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & pgam, lamc, lams, n0s, psacws, npsacws, mgncol) @@ -1483,10 +1516,10 @@ subroutine accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & enddo end subroutine accrete_cloud_water_snow -! add secondary ice production due to accretion of droplets by snow +!>\ingroup micro_mg_utils_mod +!! add secondary ice production due to accretion of droplets by snow !=================================================================== ! (Hallet-Mossop process) (from Cotton et al., 1986) - subroutine secondary_ice_production(t, psacws, msacwi, nsacwi, mgncol) integer, intent(in) :: mgncol @@ -1516,10 +1549,10 @@ subroutine secondary_ice_production(t, psacws, msacwi, nsacwi, mgncol) enddo end subroutine secondary_ice_production -! accretion of rain water by snow +!>\ingroup micro_mg_utils_mod +!! accretion of rain water by snow !=================================================================== ! formula from ikawa and saito, 1991, used by reisner et al., 1998 - subroutine accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & lamr, n0r, lams, n0s, pracs, npracs, mgncol) @@ -1588,10 +1621,10 @@ subroutine accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & enddo end subroutine accrete_rain_snow -! heterogeneous freezing of rain drops +!>\ingroup micro_mg_utils_mod +!! heterogeneous freezing of rain drops !=================================================================== ! follows from Bigg (1953) - subroutine heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr, mgncol) integer, intent(in) :: mgncol @@ -1623,11 +1656,10 @@ subroutine heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr, mgnc enddo end subroutine heterogeneous_rain_freezing -! accretion of cloud liquid water by rain -!=================================================================== -! formula from Khrouditnov and Kogan (2000) +!>\ingroup micro_mg_utils_mod +!! accretion of cloud liquid water by rain +!! formula from Khrouditnov and Kogan (2000) ! gravitational collection kernel, droplet fall speed neglected - subroutine accrete_cloud_water_rain(microp_uniform, qric, qcic, & ncic, relvar, accre_enhan, pra, npra, mgncol) @@ -1675,10 +1707,9 @@ subroutine accrete_cloud_water_rain(microp_uniform, qric, qcic, & end do end subroutine accrete_cloud_water_rain -! Self-collection of rain drops -!=================================================================== -! from Beheng(1994) - +!>\ingroup micro_mg_utils_mod +!! Self-collection of rain drops +!! from Beheng(1994) subroutine self_collection_rain(rho, qric, nric, nragg, mgncol) integer, intent(in) :: mgncol @@ -1702,12 +1733,11 @@ subroutine self_collection_rain(rho, qric, nric, nragg, mgncol) enddo end subroutine self_collection_rain - -! Accretion of cloud ice by snow +!>\ingroup micro_mg_utils_mod +!! Accretion of cloud ice by snow !=================================================================== ! For this calculation, it is assumed that the Vs >> Vi ! and Ds >> Di for continuous collection - subroutine accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & lams, n0s, prai, nprai, mgncol) @@ -1752,12 +1782,12 @@ subroutine accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & enddo end subroutine accrete_cloud_ice_snow -! calculate evaporation/sublimation of rain and snow +!>\ingroup micro_mg_utils_mod +!! calculate evaporation/sublimation of rain and snow !=================================================================== ! note: evaporation/sublimation occurs only in cloud-free portion of grid cell ! in-cloud condensation/deposition of rain and snow is neglected ! except for transfer of cloud water to snow through bergeron process - subroutine evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, & lcldm, precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & pre, prds, am_evp_st, mgncol) @@ -1875,12 +1905,12 @@ subroutine evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, & end subroutine evaporate_sublimate_precip -! evaporation/sublimation of rain, snow and graupel +!>\ingroup micro_mg_utils_mod +!! evaporation/sublimation of rain, snow and graupel !=================================================================== ! note: evaporation/sublimation occurs only in cloud-free portion of grid cell ! in-cloud condensation/deposition of rain and snow is neglected ! except for transfer of cloud water to snow through bergeron process - subroutine evaporate_sublimate_precip_graupel(t, rho, dv, mu, sc, q, qvl, qvi, & lcldm, precip_frac, arn, asn, agn, bg, qcic, qiic, qric, qsic, qgic, lamr, n0r, lams, n0s, lamg, n0g, & pre, prds, prdg, am_evp_st, mgncol) @@ -2032,10 +2062,8 @@ subroutine evaporate_sublimate_precip_graupel(t, rho, dv, mu, sc, q, qvl, qvi, & end subroutine evaporate_sublimate_precip_graupel - -! bergeron process - evaporation of droplets and deposition onto snow -!=================================================================== - +!>\ingroup micro_mg_utils_mod +!! bergeron process - evaporation of droplets and deposition onto snow subroutine bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & qcic, qsic, lams, n0s, bergs, mgncol) @@ -2084,9 +2112,8 @@ subroutine bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & end subroutine bergeron_process_snow !======================================================================== -! Collection of snow by rain to form graupel -!======================================================================== - +!>\ingroup micro_mg_utils_mod +!! Collection of snow by rain to form graupel subroutine graupel_collecting_snow(qsic,qric,umr,ums,rho,lamr,n0r,lams,n0s, & psacr, mgncol) @@ -2146,9 +2173,8 @@ subroutine graupel_collecting_snow(qsic,qric,umr,ums,rho,lamr,n0r,lams,n0s, & end subroutine graupel_collecting_snow !======================================================================== -! Collection of cloud water by graupel -!======================================================================== - +!>\ingroup micro_mg_utils_mod +!! Collection of cloud water by graupel subroutine graupel_collecting_cld_water(qgic,qcic,ncic,rho,n0g,lamg,bg,agn, & psacwg, npsacwg, mgncol) @@ -2196,9 +2222,8 @@ subroutine graupel_collecting_cld_water(qgic,qcic,ncic,rho,n0g,lamg,bg,agn, & end subroutine graupel_collecting_cld_water !======================================================================== -! Conversion of rimed cloud water onto snow to graupel/hail -!======================================================================== - +!>\ingroup micro_mg_utils_mod +!! Conversion of rimed cloud water onto snow to graupel/hail subroutine graupel_riming_liquid_snow(psacws,qsic,qcic,nsic,rho,rhosn,rhog,asn,lams,n0s,dtime, & pgsacw,nscng,mgncol) @@ -2275,9 +2300,8 @@ subroutine graupel_riming_liquid_snow(psacws,qsic,qcic,nsic,rho,rhosn,rhog,asn,l end subroutine graupel_riming_liquid_snow !======================================================================== -!CHANGE IN Q,N COLLECTION RAIN BY GRAUPEL -!======================================================================== - +!>\ingroup micro_mg_utils_mod +!!CHANGE IN Q,N COLLECTION RAIN BY GRAUPEL subroutine graupel_collecting_rain(qric,qgic,umg,umr,ung,unr,rho,n0r,lamr,n0g,lamg,& pracg,npracg,mgncol) @@ -2376,10 +2400,10 @@ subroutine graupel_collecting_rain(qric,qgic,umg,umr,ung,unr,rho,n0r,lamr,n0g,la end subroutine graupel_collecting_rain !======================================================================== -! Rain riming snow to graupel +!>\ingroup micro_mg_utils_mod +!! Rain riming snow to graupel !======================================================================== ! Conversion of rimed rainwater onto snow converted to graupel - subroutine graupel_rain_riming_snow(pracs,npracs,psacr,qsic,qric,nric,nsic,n0s, & lams,n0r,lamr,dtime,pgracs,ngracs,mgncol) @@ -2470,6 +2494,8 @@ end subroutine graupel_rain_riming_snow !======================================================================== ! Rime Splintering !======================================================================== +!>\ingroup micro_mg_utils_mod +!! Rime splintering subroutine graupel_rime_splintering(t,qcic,qric,qgic,psacwg,pracg,& qmultg,nmultg,qmultrg,nmultrg,mgncol) @@ -2668,6 +2694,7 @@ end subroutine graupel_rime_splintering !UTILITIES !======================================================================== +!>\ingroup micro_mg_utils_mod pure function no_limiter() real(r8) :: no_limiter @@ -2675,6 +2702,7 @@ pure function no_limiter() end function no_limiter +!>\ingroup micro_mg_utils_mod pure function limiter_is_on(lim) real(r8), intent(in) :: lim logical :: limiter_is_on @@ -2683,6 +2711,7 @@ pure function limiter_is_on(lim) end function limiter_is_on +!>\ingroup micro_mg_utils_mod FUNCTION gamma_incomp(muice, x) real(r8) :: gamma_incomp diff --git a/gfsphysics/physics/moninshoc.f b/gfsphysics/physics/moninshoc.f index bce594d89..d68c001b5 100644 --- a/gfsphysics/physics/moninshoc.f +++ b/gfsphysics/physics/moninshoc.f @@ -83,6 +83,13 @@ subroutine moninshoc(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 @@ -125,8 +132,9 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! 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) @@ -332,6 +340,8 @@ subroutine moninshoc(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 ! @@ -504,6 +514,8 @@ subroutine moninshoc(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 tridi1(l,n,cl,cm,cu,r1,au,a1) diff --git a/gfsphysics/physics/rascnvv2.f b/gfsphysics/physics/rascnvv2.f index ebc7c9fbb..4d49889de 100644 --- a/gfsphysics/physics/rascnvv2.f +++ b/gfsphysics/physics/rascnvv2.f @@ -315,7 +315,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& &, rainp ! - Integer KCR, KFX, NCMX, NC, KTEM, I, L, lm1 & + Integer KCR, KFX, NCMX, NC, KTEM, I, ii, Lm1, l & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc @@ -339,6 +339,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! if (lprnt) write(0,*)' in RAS fscav=',fscav_,' ccwfac=', ! & ccwfac(ipr),' mp_phys=',mp_phys ! &, ' fscav=',fscav,' trac=',trac +! &, ' rannum=',rannum(1,:) ! km1 = k - 1 kp1 = k + 1 @@ -396,6 +397,9 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & enddo DO IPT=1,IM + lprint = lprnt .and. ipt == ipr + ia = ipr + ccwf = half if (ccwfac(ipt) >= zero) ccwf = ccwfac(ipt) @@ -403,6 +407,9 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & tem = one + dlq_fac c0 = c00(IPT) * tem c0i = c00i(IPT) * tem + +! if (lprint) write(0,*)' c0=',c0,' c0i=',c0i,' dlq_fac=',dlq_fac, & +! & ' ccwf=',ccwf ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -437,7 +444,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & krmin = max(krmin,2) ! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx -! if (lprnt .and. ipt == ipr) write(0,*)' krmin=',krmin,' krmax=', +! if (lprint) write(0,*)' krmin=',krmin,' krmax=', ! &krmax,' kfmax=',kfmax,' tem=',tem ! if (fix_ncld_hr) then @@ -460,8 +467,9 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & KTEM = MIN(K,KFMAX) KFX = KTEM - KCR -! if(lprnt)write(0,*)' enter RASCNV k=',k,' ktem=',ktem +! 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 @@ -479,22 +487,24 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & NCMX = KFX + NCRND IF (NCRND > 0) THEN DO I=1,NCRND - IRND = (RANNUM(ipt,I)-0.0005)*(KCR-KRMIN+1) + II = mod(i-1,nrcm) + 1 + IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF ! -! ia = 1 -! ! write(0,*)' in rascnv: k=',k,'lat=',lat,' lprnt=',lprnt -! if (lprnt) then +! if (lprint) then ! if (me == 0) then +! write(0,*)' ic=',ic(1:kfx+ncrnd) ! write(0,*)' tin',(tin(ia,l),l=k,1,-1) -! write(0,*)' qin',(qin(ia,l),l=k,1,-1) +! 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 +! lprint = lprnt .and. ipt == ipr do l=1,k CLW(l) = zero @@ -1110,17 +1120,22 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) enddo endif + endif ! -! if (lprint) then -! write(0,*) ' tin',(tin(ia,l),l=k,1,-1) -! write(0,*) ' qin',(qin(ia,l),l=k,1,-1) -! 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! ! 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! @@ -1319,8 +1334,8 @@ SUBROUTINE CLOUD( & ! write(0,*) ' phil=',phil(KD:K) !! write(0,*) ' phih=',phih(kd:KP1),' kdt=',kdt ! write(0,*) ' phih=',phih(KD:KP1) -! write(0,*) ' toi=',toi -! write(0,*) ' qoi=',qoi +! write(0,*) ' toi=',toi(kd:k) +! write(0,*) ' qoi=',qoi(kd:k) ! endif ! CLDFRD = zero @@ -1702,8 +1717,10 @@ SUBROUTINE CLOUD( & ! ! if (ntk > 0 .and. do_aw) then if (ntk > 0) then - wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) -! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + if (rbl(ntk) > 0.0) then + wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + endif endif ! if (lprnt) write(0,*)' wcbase=',wcbase,' rbl=', @@ -2778,7 +2795,8 @@ SUBROUTINE CLOUD( & !! tem1 = sqrt(max(1.0, min(100.0,(4.0E10/max(garea,one))))) ! 20100902 tem1 = sqrt(max(one, min(100.0,(6.25E10/max(garea,one))))) ! 20110530 -! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=',tem1 +! 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)) @@ -4410,8 +4428,9 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) real(kind=kind_phys) es, d, hlorv, W ! ! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = 0.01 * fpvs(tt) ! fpvs is in Pascals! - D = one / max(p+epsm1*es,ONE_M10) + es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! +! D = one / max(p+epsm1*es,ONE_M10) + D = one / (p+epsm1*es) ! q = MIN(eps*es*D, ONE) ! diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index d1da89c3d..ea08f5056 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -224,7 +224,7 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) - else if (sfc_z0_type /= 0) then + else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type stop endif @@ -238,31 +238,33 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) ! ! update z0 over ocean ! - if (sfc_z0_type == 0) then - z0 = (charnock / grav) * ustar(i,3) * ustar(i,3) + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / grav) * ustar(i,3) * ustar(i,3) ! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) ! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl(i,3) = 100.0 * max(min(z0, z0s_max), 1.e-7) +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl(i,3) = 100.0 * max(min(z0, z0s_max), 1.e-7) + else + z0rl(i,3) = 100.0 * max(min(z0,.1), 1.e-7) + endif + + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl(i,3) = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl(i,3) = 100.0 * z0 ! cm else - z0rl(i,3) = 100.0 * max(min(z0,.1), 1.e-7) + z0rl(i,3) = 1.0e-4 endif - - elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl(i,3) = 100.0 * z0 ! cm - elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl(i,3) = 100.0 * z0 ! cm - else - z0rl(i,3) = 1.0e-4 endif endif ! end of if(open ocean) diff --git a/gfsphysics/physics/sfc_nst.f b/gfsphysics/physics/sfc_nst.f index 68b9b0982..51694d6cc 100644 --- a/gfsphysics/physics/sfc_nst.f +++ b/gfsphysics/physics/sfc_nst.f @@ -210,7 +210,7 @@ subroutine sfc_nst & ! integer :: k,i ! - real (kind=kind_phys), dimension(im) :: q0, qss, rch, + real (kind=kind_phys), dimension(im) :: q0, qss, rch, & rho_a, theta1, tv1, wndmag real(kind=kind_phys) elocp,tem @@ -218,7 +218,7 @@ subroutine sfc_nst & ! nstm related prognostic fields ! logical flag(im) - real (kind=kind_phys), dimension(im) :: + real (kind=kind_phys), dimension(im) :: & xt_old, xs_old, xu_old, xv_old, xz_old,zm_old,xtts_old, & xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old diff --git a/gfsphysics/physics/sfc_sice.f b/gfsphysics/physics/sfc_sice.f index 84fe55061..72addd6f1 100644 --- a/gfsphysics/physics/sfc_sice.f +++ b/gfsphysics/physics/sfc_sice.f @@ -171,7 +171,7 @@ subroutine sfc_sice & integer :: i, k - + logical :: flag(im) ! !===> ... begin here diff --git a/gfsphysics/physics/ugwp_driver_v0.f b/gfsphysics/physics/ugwp_driver_v0.f index 41193aad0..4603208fc 100644 --- a/gfsphysics/physics/ugwp_driver_v0.f +++ b/gfsphysics/physics/ugwp_driver_v0.f @@ -4,11 +4,11 @@ module sso_coorde ! specific to COORDE-2019 project OGW switches/sensitivity ! to diagnose SSO effects pgwd=1 (OGW is on) =0 (off) ! pgd4=4 (4 timse taub, control pgwd=1) -! +! use machine, only: kind_phys real(kind=kind_phys),parameter :: pgwd = 1._kind_phys real(kind=kind_phys),parameter :: pgwd4 = 1._kind_phys - end module sso_coorde + end module sso_coorde ! ! subroutine cires_ugwp_driver_v0(me, master, @@ -16,7 +16,7 @@ subroutine cires_ugwp_driver_v0(me, master, & cdmbgwd, xlat, xlatd, sinlat, coslat, spgrid, & ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, & phii, phil, del, hprime, oc, oa4, clx, theta, - & gamm, sigma, elvmax, sgh30, kpbl, + & gamm, sigma, elvmax, sgh30, kpbl, & dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_tofd, tau_mtb, tau_ogw, tau_ngw, & zmtb, zlwb, zogw, du3dt_mtb,du3dt_ogw, du3dt_tms,rdxzb, @@ -26,15 +26,15 @@ subroutine cires_ugwp_driver_v0(me, master, ! Part 2 non-stationary multi-wave GWs FV3GFS-v0 ! Part 3 Dissipative version of UGWP-tendency application ! (similar to WAM-2017) -!----------------------------------------------------------- +!----------------------------------------------------------- use machine, only : kind_phys use physcons, only : con_cp, con_g, con_rd, con_rv - + use ugwp_wmsdis_init, only : tamp_mpa, ilaunch use sso_coorde, only : pgwd, pgwd4 implicit none !input - + integer, intent(in) :: me, master integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr @@ -48,7 +48,7 @@ subroutine cires_ugwp_driver_v0(me, master, real(kind=kind_phys), intent(in), dimension(im,levs) :: ugrs &, vgrs, tgrs, qgrs, prsl, prslk, phil, del real(kind=kind_phys), intent(in), dimension(im,levs+1) :: prsi - &, phii + &, phii ! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc @@ -81,7 +81,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! real(kind=kind_phys), dimension(im) :: hprime, ! & oc, theta, sigma, gamm, elvmax ! real(kind=kind_phys), dimension(im, 4) :: clx, oa4 -! +! ! switches that activate impact of OGWs and NGWs along with eddy diffusion ! real(kind=kind_phys), parameter :: pogw=1.0, pngw=1.0, pked=1.0 @@ -98,14 +98,14 @@ subroutine cires_ugwp_driver_v0(me, master, write(6,*) ' COORDE EXPER pgwd4 = ', pgwd4 print * endif - + do i=1,im zlwb(i) = 0. enddo ! ! 1) ORO stationary GWs ! ------------------ - + if (do_ugwp .and. nmtvr == 14) then ! calling revised old GFS gravity wave drag CALL GWDPS_V0(IM, levs, imx, do_tofd, & Pdvdt, Pdudt, Pdtdt, Pkdis, @@ -122,7 +122,7 @@ subroutine cires_ugwp_driver_v0(me, master, print * write(6,*) 'FV3GFS finished gwdps_v0 in ugwp_driver_v0 ' print * - endif + endif else ! calling old GFS gravity wave drag as is do k=1,levs do i=1,im @@ -149,11 +149,11 @@ subroutine cires_ugwp_driver_v0(me, master, if (cdmbgwd(3) > 0.0) then ! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing ! ---------------------------------------------- -!-------- +!-------- ! GMAO GEOS-5/MERRA GW-forcing lat-dep !-------- call slat_geos5_tamp(im, tamp_mpa, xlatd, tau_ngw) - + ! call slat_geos5(im, xlatd, tau_ngw) ! if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then @@ -186,7 +186,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! call fv3_ugwp_solv2_v0(im, levs, dtp, & tgrs, ugrs, vgrs, qgrs, prsl, prsi, - & phil, xlatd, sinlat, coslat, + & phil, xlatd, sinlat, coslat, & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & tau_ngw, me, master, kdt) @@ -252,11 +252,11 @@ subroutine cires_ugwp_driver_v0(me, master, enddo end subroutine cires_ugwp_driver_v0 -! -!===================================================================== ! -!ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 -! +!===================================================================== +! +!ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 +! !===================================================================== SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, @@ -302,7 +302,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! real(kind=kind_phys), intent(in) :: dtp ! time step real(kind=kind_phys), intent(in) :: cdmbgwd(2) - + real(kind=kind_phys), intent(in), dimension(im,km) :: & u1, v1, t1, q1, & del, prsl, prslk, phil @@ -316,20 +316,20 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys), intent(in) :: ELVMAXD(IM), THETA(IM) real(kind=kind_phys), intent(in) :: vSIGMA(IM), vGAMMA(IM) real(kind=kind_phys) :: SIGMA(IM), GAMMA(IM) - + !output -phys-tend real(kind=kind_phys),dimension(im,km),intent(out) :: & Pdvdt, Pdudt, Pkdis, Pdtdt ! output - diag-coorde &, dudt_mtb, dudt_ogw, dudt_tms -! +! real(kind=kind_phys),dimension(im) :: RDXZB, zmtb, zogw &, tau_ogw, tau_mtb, tau_tofd &, dusfc, dvsfc ! !--------------------------------------------------------------------- ! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 ! 4.*gamma*b_ell*b_ell >= shilmin ! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min ! gamma_min = 1/4*shilmin/sso_min/sso_min @@ -347,21 +347,21 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: belpmin, dsmin, dsmax ! real(kind=kind_phys) :: arhills(im) ! not used why do we need? real(kind=kind_phys) :: xlingfs - -! -! locals + +! +! locals ! mean flow real(kind=kind_phys), dimension(im,km) :: RI_N, BNV2, RO &, VTK, VTJ, VELCO -!mtb +!mtb real(kind=kind_phys), dimension(im) :: OA, CLX , elvmax, wk &, PE, EK, UP - + real(kind=kind_phys), dimension(im,km) :: DB, ANG, UDS real(kind=kind_phys) :: ZLEN, DBTMP, R, PHIANG, DBIM, ZR real(kind=kind_phys) :: ENG0, ENG1, COSANG2, SINANG2 - real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem ! ! TOFD ! Some constants now in "use ugwp_oro_init" + "use ugwp_common" @@ -372,7 +372,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, epstofd1, krf_tofd1 &, up1, vp1, zpm real(kind=kind_phys),dimension(im, km) :: axtms, aytms -! +! ! OGW ! LOGICAL ICRILV(IM) @@ -383,9 +383,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: TAUP(IM,km+1), TAUD(IM,km) real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis - integer, dimension(im) :: kref, idxzb, ipt, kreflm, + integer, dimension(im) :: kref, idxzb, ipt, kreflm, & iwklm, iwk, izlow -! +! !check what we need ! real(kind=kind_phys) :: bnv, fr, ri_gw @@ -399,7 +399,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, cdmb4, mtbridge &, kxridge, inv_b2eff, zw1, zw2 &, belps, aelps, nhills, selps - + integer :: kmm1, kmm2, lcap, lcapp1 &, npt, kbps, kbpsp1,kbpsm1 &, kmps, idir, nwd, klcap, kp1, kmpbl, kmll @@ -409,7 +409,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, grav2 = grav + grav ! ! mtb-blocking sigma_min and dxres => cires_initialize -! +! sgrmax = maxval(sparea) ; sgrmin = minval(sparea) dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) @@ -444,9 +444,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, idxzb(i) = 0 zmtb(i) = 0.0 zogw(i) = 0.0 - rdxzb(i) = 0.0 + rdxzb(i) = 0.0 tau_ogw(i) = 0.0 - tau_mtb(i) = 0.0 + tau_mtb(i) = 0.0 dusfc(i) = 0.0 dvsfc(i) = 0.0 tau_tofd(i) = 0.0 @@ -467,13 +467,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dudt_tms(i,k) = 0.0 enddo enddo - + ! ---- for lm and gwd calculation points - + npt = 0 do i = 1,im if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then - + npt = npt + 1 ipt(npt) = i ! arhills(i) = 1.0 @@ -488,7 +488,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! small-scale "turbulent" oro-scales < sso_min ! if( aelps < sso_min .and. do_adjoro) then - + ! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm ! aelps = sso_min @@ -506,38 +506,38 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, nhills = min(nhilmax, sparea(i)/selps) ! arhills(i) = max(nhills, 1.0) -!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) +!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) ! if (kdt==1 ) ! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, ! & belps*1.e-3, sigma(i),gamma(i) endif enddo - + IF (npt == 0) then ! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin +! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin RETURN ! No gwd/mb calculation done endif do i=1,npt iwklm(i) = 2 - IDXZB(i) = 0 + IDXZB(i) = 0 kreflm(i) = 0 enddo - + do k=1,km do i=1,im db(i,k) = 0.0 ang(i,k) = 0.0 - uds(i,k) = 0.0 + uds(i,k) = 0.0 enddo enddo KMM1 = km - 1 ; KMM2 = km - 2 ; KMLL = kmm1 - LCAP = km ; LCAPP1 = LCAP + 1 - + LCAP = km ; LCAPP1 = LCAP + 1 + DO I = 1, npt j = ipt(i) ELVMAX(J) = min (ELVMAXd(J)*0. + sigfac * hprime(j), hncrit) @@ -548,11 +548,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO I = 1, npt j = ipt(i) ztopH = sigfac * hprime(j) - zlowH = sigfacs* hprime(j) + zlowH = sigfacs* hprime(j) pkp1log = phil(j,k+1) * rgrav pklog = phil(j,k) * rgrav ! if (( ELVMAX(j) <= pkp1log) .and. (ELVMAX(j).ge.pklog) ) -! & iwklm(I) = MAX(iwklm(I), k+1 ) +! & iwklm(I) = MAX(iwklm(I), k+1 ) if (( ztopH <= pkp1log) .and. (zTOPH >= pklog) ) & iwklm(I) = MAX(iwklm(I), k+1 ) ! @@ -588,18 +588,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) & / (VTK(I,K+1)+VTK(I,K)) bnv2(i,k+1) = max( BVF2, bnv2min ) - RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 + RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 ! ! add here computation for Ktur and OGW-dissipation fro VE-GFS -! +! ENDDO ENDDO K = 1 DO I = 1, npt bnv2(i,k) = bnv2(i,k+1) ENDDO -! -! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g +! +! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g ! DO I = 1, npt J = ipt(i) @@ -612,19 +612,19 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ROLL (I) = 0.0 PE (I) = 0.0 EK (I) = 0.0 - BNV2bar(I) = 0.0 + BNV2bar(I) = 0.0 ENDDO ! DO I = 1, npt k_zlow = izlow(I) if (k_zlow == iwklm(i)) k_zlow = 1 - DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 + DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 J = ipt(i) ! laye-aver Rho, U, V RDELKS = DEL(J,K) * DELKS(I) - UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below - VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below - ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below -! + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below +! BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS ENDDO ENDDO @@ -634,24 +634,24 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! integrate from Ztoph = sigfac*hprime down to Zblk if exists ! find ph_blk, dz_blk like in LM-97 and IFS -! - ph_blk =0. +! + ph_blk = 0. DO K = iwklm(I), 1, -1 PHIANG = atan2(V1(J,K),U1(J,K))*RAD_TO_DEG ANG(I,K) = ( THETA(J) - PHIANG ) if ( ANG(I,K) > 90. ) ANG(I,K) = ANG(I,K) - 180. if ( ANG(I,K) < -90. ) ANG(I,K) = ANG(I,K) + 180. ANG(I,K) = ANG(I,K) * DEG_TO_RAD - UDS(I,K) = + UDS(I,K) = & MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), velmin) ! IF (IDXZB(I) == 0 ) then dz_blk = ( PHII(J,K+1) - PHII(J,K) ) *rgrav - PE(I) = PE(I) + BNV2(I,K) * + PE(I) = PE(I) + BNV2(I,K) * & ( ELVMAX(J) - phil(J,K)*rgrav ) * dz_blk - UP(I) = max(UDS(I,K) * cos(ANG(I,K)), velmin) - EK(I) = 0.5 * UP(I) * UP(I) + UP(I) = max(UDS(I,K) * cos(ANG(I,K)), velmin) + EK(I) = 0.5 * UP(I) * UP(I) ph_blk = ph_blk + dz_blk*sqrt(BNV2(I,K))/UP(I) @@ -667,7 +667,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDDO ! ! Alternative expression: ZMTB = max(Heff*(1. -Fcrit_gfs/Fr), 0) -! fcrit_gfs/fr +! fcrit_gfs/fr ! goto 788 @@ -678,7 +678,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, Fr = heff*bnv/Ulow(i) ZW1 = max(Heff*(1. -fcrit_gfs/fr), 0.0) zw2 = phil(j,2)*rgrav - if (Fr > fcrit_gfs .and. zw1 > zw2 ) then + if (Fr > fcrit_gfs .and. zw1 > zw2 ) then do k=2, kmm1 pkp1log = phil(j,k+1) * rgrav pklog = phil(j,k) * rgrav @@ -695,54 +695,54 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! --- The drag for mtn blocked flow -! +! cdmb4 = 0.25*cdmb DO I = 1, npt J = ipt(i) ! IF ( IDXZB(I) > 0 ) then -! (4.16)-IFS +! (4.16)-IFS gam2 = gamma(j)*gamma(j) BGAM = 1.0 - 0.18*gamma(j) - 0.04*gam2 CGAM = 0.48*gamma(j) + 0.30*gam2 DO K = IDXZB(I)-1, 1, -1 - ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / + ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / & ( PHIL(J,K ) + Grav * hprime(J) ) ) tem = cos(ANG(I,K)) COSANG2 = tem * tem - SINANG2 = 1.0 - COSANG2 + SINANG2 = 1.0 - COSANG2 ! -! cos =1 sin =0 => 1/R= gam ZR = 2.-gam +! cos =1 sin =0 => 1/R= gam ZR = 2.- gam ! cos =0 sin =1 => 1/R= 1/gam ZR = 2.- 1/gam ! rdem = COSANG2 + GAM2 * SINANG2 rnom = COSANG2*GAM2 + SINANG2 -! +! ! metOffice Dec 2010 ! correction of H. Wells & A. Zadra for the ! aspect ratio of the hill seen by MF ! (1/R , R-inverse below: 2-R) - rdem = max(rdem, 1.e-6) + rdem = max(rdem, 1.e-6) R = sqrt(rnom/rdem) ZR = MAX( 2. - R, 0. ) sigres = max(sigmin, sigma(J)) if (hprime(J)/sigres > dxres) sigres = hprime(J)/dxres mtbridge = ZR * sigres*ZLEN / hprime(J) -! (4.15)-IFS +! (4.15)-IFS ! DBTMP = CDmb4 * mtbridge * ! & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) ! (4.16)-IFS DBTMP = CDmb4*mtbridge*(bgam* COSANG2 +cgam* SINANG2) DB(I,K)= DBTMP * UDS(I,K) ENDDO -! +! endif ENDDO -! +! !............................. !............................. ! end mtn blocking section @@ -750,7 +750,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !............................. ! !--- Orographic Gravity Wave Drag Section -! +! ! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 ! inside "cires_ugwp_initialize.F90" now ! @@ -759,18 +759,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! METO-scheme: ! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw -! +! DO K=3,KMPBL DO I=1,npt j = ipt(i) tem = (prsi(j,1) - prsi(j,k)) if (tem < dpmin) iwk(i) = k ! dpmin=50 mb -!=============================================================== +!=============================================================== ! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 ! below "Hprime" - source of OGWs and below Zblk !!! ! 27 2 kpbl ~ 1-2 km < Hprime -!=============================================================== +!=============================================================== enddo enddo ! @@ -847,7 +847,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! !------------------ ! v0: incorporates latest modifications for kxridge and heff/hsat -! and taulin for Fr <=fcrit_gfs +! and taulin for Fr <=fcrit_gfs ! and concept of "clipped" hill if zmtb > 0. to make ! the integrated "tau_sso = tau_ogw +tau_mtb" close to reanalysis data ! it is still used the "single-OGWave"-approach along ULOW-upwind @@ -986,10 +986,10 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDIF ENDDO ENDDO -! +! ! zero momentum deposition at the top model layer -! - taup(1:npt,km+1) = taup(1:npt,km) +! + taup(1:npt,km+1) = taup(1:npt,km) ! ! Calculate wave acc-n: - (grav)*d(tau)/d(p) = taud ! @@ -1000,11 +1000,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDDO ! !------scale MOMENTUM DEPOSITION AT TOP TO 1/2 VALUE -! it is zero now +! it is zero now ! DO I = 1,npt ! TAUD(I, km) = TAUD(I,km) * FACTOP ! ENDDO - + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !------IF THE GRAVITY WAVE DRAG WOULD FORCE A CRITICAL LINE IN THE !------LAYERS BELOW SIGMA=RLOLEV DURING THE NEXT DELTIM TIMESTEP, @@ -1029,23 +1029,23 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! !--------------------------- OROGW-solver of GFS PSS-1986 ! - else + else ! !--------------------------- OROGW-solver of WAM2017 ! ! sigres = max(sigmin, sigma(J)) ! if (heff/sigres.gt.dxres) sigres=heff/dxres -! inv_b2eff = 0.5*sigres/heff -! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge +! inv_b2eff = 0.5*sigres/heff +! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge dtfac(:) = 1.0 - + call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, & del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) - + endif ! oro_wam_2017 - LINSATDIS-solver of WAM-2017 -! +! !--------------------------- OROGW-solver of WAM2017 ! ! TOFD as in BELJAARS-2004 @@ -1056,42 +1056,42 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, if ( kdt == 1 .and. me == 0) then print *, 'VAY do_tofd from surface to ', ztop_tofd endif - DO I = 1,npt + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) - + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of LS-SSO - + zsurf = phii(j,1)*rgrav do k=1,km zpm(k) = phiL(j,k)*rgrav up1(k) = u1(j,k) vp1(k) = v1(j,k) enddo - - call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, + + call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) - + do k=1,km axtms(j,k) = utofd1(k) aytms(j,k) = vtofd1(k) -! +! ! add TOFD to GW-tendencies -! +! pdvdt(J,k) = pdvdt(J,k) + aytms(j,k) pdudt(J,k) = pdudt(J,k) + axtms(j,k) enddo !2018-diag tau_tofd(J) = sum( utofd1(1:km)* del(j,1:km)) enddo - ENDIF ! do_tofd + ENDIF ! do_tofd !--------------------------- ! combine oro-drag effects -!--------------------------- +!--------------------------- ! + diag-3d - dudt_tms = axtms + dudt_tms = axtms tau_ogw = 0. tau_mtb = 0. @@ -1236,8 +1236,8 @@ end subroutine gwdps_v0 ! next will be lsatdis for both fv3wam & fv3gfs-128l implementations ! with (a) stochastic-deterministic propagation solvers for wave packets/spectra ! (b) gw-sources: oro/convection/dyn-instability (fronts/jets/pv-anomalies) -! (c) guidance from high-res runs for GW sources and res-aware tune-ups -!23456 +! (c) guidance from high-res runs for GW sources and res-aware tune-ups +!23456 ! ! call gwdrag_wam(1, im, ix, km, ksrc, dtp, ! & xlat, gw_dudt, gw_dvdt, taux, tauy) @@ -1262,8 +1262,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! nov 2015 alternative gw-solver for nggps-wam ! nov 2017 nh/rotational gw-modes for nh-fv3gfs ! --------------------------------------------------------------------------------- -! - +! + use ugwp_common , only : rgrav, grav, cpd, rd, rv &, omega2, rcpd2, pi, pi2, fv &, rad_to_deg, deg_to_rad @@ -1277,15 +1277,15 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, &, zci, zdci, zci4, zci3, zci2 &, zaz_fct, zcosang, zsinang &, nwav, nazd, zcimin, zcimax -! +! implicit none !23456 - + integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles - real, intent(in) :: dtime ! model time step - real, intent(in) :: vm1(klon,klev) ! meridional wind + real, intent(in) :: dtime ! model time step + real, intent(in) :: vm1(klon,klev) ! meridional wind real, intent(in) :: um1(klon,klev) ! zonal wind real, intent(in) :: qm1(klon,klev) ! spec. humidity real, intent(in) :: tm1(klon,klev) ! kin temperature @@ -1306,19 +1306,19 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, intent(out) :: pdudt(klon,klev) ! zonal momentum tendency real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp - real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5 ! - real, parameter :: epsln = 1.0d-12 ! - + real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion + real, parameter :: minvel = 0.5 ! + real, parameter :: epsln = 1.0d-12 ! + !vay-2018 real :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) real :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) - real :: phil(klon,klev) ! gphil/grav + real :: phil(klon,klev) ! gphil/grav ! ! local =============================================================================================== ! - + ! real :: zthm1(klon,klev) ! temperature interface levels real :: zthm1 ! 1.0 / temperature interface levels real :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency @@ -1328,7 +1328,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real :: zvhm1(klon,ilaunch:klev) ! meridional wind real :: v_zmet(klon,ilaunch:klev) real :: vueff(klon,ilaunch:klev) - real :: zbvfl(klon) ! BV at launch level + real :: zbvfl(klon) ! BV at launch level real :: c2f2(klon) !23456 @@ -1359,7 +1359,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc real :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft, ze1, ze2 -! +! real :: zdelp,zrgpts real :: zthstd,zrhostd,zbvfstd real :: tvc1, tvm1, tem1, tem2, tem3 @@ -1371,13 +1371,13 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp &, cpdi = 1.0d0/cpd - + real :: expdis, fdis ! real :: fmode, expdis, fdis real :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 integer :: j, k, inc, jk, jl, iazi -! +! !-------------------------------------------------------------------------- ! do k=1,klev @@ -1389,16 +1389,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, phil(j,k) = philg(j,k) * rgrav enddo enddo -!----------------------------------------------------------- +!----------------------------------------------------------- ! also other options to alter tropical values ! tamp = 100.e-3*1.e3 = 100 mpa -! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 +! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 !----------------------------------------------------------- -! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) +! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) - -! phil = philg*rgrav +! phil = philg*rgrav + ! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] ! grav2cpd = grav*grav/cpd ! g*(g/cp)= g^2/cp @@ -1420,7 +1420,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! +! ! set initial min Cxi for critical level absorption do iazi=1,nazd do jl=1,klon @@ -1437,8 +1437,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zthm1 = 2.0 / (tvc1+tvm1) zuhm1(jl,jk) = 0.5 *(um1(jl,jk-1)+um1(jl,jk)) zvhm1(jl,jk) = 0.5 *(vm1(jl,jk-1)+vm1(jl,jk)) -! zrhohm1(jl,jk) = prsi(jl,jk)*rdi/zthm1(jl,jk) ! rho = p/(RTv) - zrhohm1(jl,jk) = prsi(jl,jk)*rdi*zthm1 ! rho = p/(RTv) +! zrhohm1(jl,jk) = prsi(jl,jk)*rdi/zthm1(jl,jk) ! rho = p/(RTv) + zrhohm1(jl,jk) = prsi(jl,jk)*rdi*zthm1 ! rho = p/(RTv) zdelp = phil(jl,jk)-phil(jl,jk-1) !>0 ...... dz-meters v_zmet(jl,jk) = zdelp + zdelp delpi(jl,jk) = grav / (prsi(jl,jk-1) - prsi(jl,jk)) @@ -1449,7 +1449,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zbn2(jl,jk) = grav2cpd*zthm1 & * (1.0+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) - zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) + zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) enddo enddo @@ -1472,7 +1472,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! ! define intrinsic velocity (relative to launch level velocity) u(z)-u(zo), and coefficinets -! ------------------------------------------------------------------------------------------ +! ------------------------------------------------------------------------------------------ do iazi=1, nazd do jl=1,klon zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) @@ -1606,7 +1606,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! ------------------------------------------------------------- +! ------------------------------------------------------------- ! azimuth do-loop ! -------------------- do iazi=1, nazd @@ -1673,8 +1673,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, !======================================================================= ! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat ! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) -! define kxw = -!======================================================================= +! define kxw = +!======================================================================= v_cdp = abs(zcin-zui(jL,jk,iazi)) v_wdp = v_kxw*v_cdp wdop2 = v_wdp* v_wdp @@ -1702,7 +1702,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_kzw = 0. v_cdp = 0. ! no effects of reflected waves endif - + ! fmode = zflux(jl,inc,iazi) ! fdis = fmode*expdis fdis = expdis * zflux(jl,inc,iazi) @@ -1711,10 +1711,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] ! zfluxs = zfct(jl,jk)*v_cdp*v_cdp*zcinc -! +! ! zfluxs= zfct(jl,jk)*(zcin-zui(jl,jk,iazi))**2/zcin ! flux_tot - sat.flux -! +! zdep = zact(jl,inc,iazi)* (fdis-zfluxs) if(zdep > 0.0 ) then ! subs on sat-limit @@ -1737,7 +1737,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, do jl=1,klon vc_zflx_mode = zact(jl,inc,iazi)*zflux(jl,inc,iazi) zpu(jl,jk,iazi) = zpu(jl,jk,iazi) + vc_zflx_mode*zcinc - + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! check monotonic decrease ! (heat deposition integration over spectral mode for each azimuth @@ -1756,25 +1756,25 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! ! endif - enddo !jl=1,klon + enddo !jl=1,klon enddo !waves inc=1,nwav ! -------------- enddo ! end jk do-loop vertical loop ! --------------- enddo ! end nazd do-loop -! ---------------------------------------------------------------------------- +! ---------------------------------------------------------------------------- ! sum contribution for total zonal and meridional flux + ! energy dissipation ! --------------------------------------------------- -! +! do jk=1,klev+1 do jl=1,klon - taux(jl,jk) = 0.0 - tauy(jl,jk) = 0.0 + taux(jl,jk) = 0.0 + tauy(jl,jk) = 0.0 enddo - enddo - + enddo + tem3 = zaz_fct*cpdi do iazi=1,nazd tem1 = zaz_fct*zcosang(iazi) @@ -1790,7 +1790,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! ! update du/dt and dv/dt tendencies ..... no contribution to heating => keddy/tracer-mom-heat -! ---------------------------- +! ---------------------------- ! do jk=ilaunch,klev @@ -1801,7 +1801,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ze2 = (tauy(jl,jk)-tauy(jl,jk-1))*zdelp if (abs(ze1) >= maxdudt ) then ze1 = sign(maxdudt, ze1) - endif + endif if (abs(ze2) >= maxdudt ) then ze2 = sign(maxdudt, ze2) endif @@ -1816,9 +1816,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! if (dked(jl,jk) < 0) dked(jl,jk) = dked_min enddo enddo -! +! ! add limiters/efficiency for "unbalanced ics" if it is needed -! +! do jk=ilaunch,klev do jl=1, klon pdudt(jl,jk) = gw_eff * pdudt(jl,jk) @@ -1881,7 +1881,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! locals ! integer :: i, j, k -!------------------------------------------------------------------------ +!------------------------------------------------------------------------ ! solving 1D-vertical eddy diffusion to "smooth" ! GW-related tendencies: du/dt, dv/dt, d(PT)/dt ! we need to use sum of molecular + eddy terms including turb-part @@ -1901,7 +1901,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! 1-st trial w/o PBL interactions: add dU, dV dT tendencies ! compute BV, SHR2, Ri => Kturb, Kturb + Kwave => Apply it to "X_Tend +X " ! ed_X = X_ed - X => final eddy tendencies -!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- ! rzs=30m dk = rzs*rzs*sqrt(shr2(i,k)) ! Ktemp = dk/(1+5.*ri)**2 Kmom = Pr*Ktemp ! @@ -1912,26 +1912,26 @@ subroutine edmix_ugwp_v0(im, levs, dtp, real(kind=kind_phys),dimension(levs) :: bn2, shr2, ksum real(kind=kind_phys) :: eps_shr, eps_bn2, eps_dis real(kind=kind_phys) :: rdz , uz, vz, ptz -! ------------------------------------------------------------------------- +! ------------------------------------------------------------------------- ! Prw*Lsat2 =1, for GW-eddy diffusion Pr_wave = Kv/Kt ! Pr_wave ~1/Lsat2 = 1/Frcit2 = 2. => Lsat2 = 1./2 (Frc ~0.7) -! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit +! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit ! > PBL: 0.25 < prnum = 1.0 + 2.1*ri < 4 ! monin-edmf parameter(rlam=30.0,vk=0.4,vk2=vk*vk) rlamun=150.0 ! real(kind=kind_phys), parameter :: iPr_pt = 0.5, dw2min = 1.e-4 - real(kind=kind_phys), parameter :: lturb = 30., sc2 = lturb*lturb + real(kind=kind_phys), parameter :: lturb = 30., sc2 = lturb*lturb real(kind=kind_phys), parameter :: ulturb=150.,sc2u=ulturb* ulturb real(kind=kind_phys), parameter :: ric =0.25 real(kind=kind_phys), parameter :: rimin = -10., prmin = 0.25 real(kind=kind_phys), parameter :: prmax = 4.0 real(kind=kind_phys), parameter :: hps = 7000., h4 = 0.25/hps real(kind=kind_phys), parameter :: kedmin = 0.01, kedmax = 250. - - + + real(kind=kind_phys) :: rdtp, rineg, kamp, zmet, zgrow real(kind=kind_phys) :: stab, stab_dt, dtstab, ritur - integer :: nstab + integer :: nstab real(kind=kind_phys) :: w1, w2, w3 rdtp = 1./dtp nstab = 1 @@ -1983,7 +1983,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, stab = 2.*ksum(k)*rdz*rdz*dtp if ( stab >= 1.0 ) then stab_dt = max(stab_dt, stab) - endif + endif enddo nstab = max(1, nint(stab_dt)+1) dtstab = dtp / float(nstab) @@ -1991,7 +1991,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, Fw(1:levs) = pdudt(i, 1:levs) Fw1(1:levs) = pdvdt(i, 1:levs) Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) - + do j=1, nstab call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, & rdp, rdpm, Sw, Sw1) @@ -2001,7 +2001,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ed_dudt(i,:) = Sw ed_dvdt(i,:) = Sw1 - + Pt(1:levs) = t1(i,1:levs)*Ptmap(1:levs) Kpt = Km*iPr_pt Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) @@ -2023,10 +2023,10 @@ subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) integer :: i, k - real(kind=kind_phys) :: Kp1, ad, cd, bd -! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd + real(kind=kind_phys) :: Kp1, ad, cd, bd +! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd ! S(:) = 0.0 ; S1(:) = 0.0 -! +! ! explicit diffusion solver ! k = 1 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 972d43fde..25735d727 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -625,6 +625,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if (nint(oro_var2(1,1,18)) == -9999._kind_phys) then ! lakefrac doesn't exist in the restart, need to create it if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - will computing lakefrac') Model%frac_grid = .false. + elseif (Model%frac_grid_off) then + Model%frac_grid = .false. else Model%frac_grid = .true. endif @@ -1128,7 +1130,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) + Sfcprop(nb)%tsfco(ix) * tem enddo enddo - else ! in this case ice fracion is fraction of water fraction + else ! in this case ice fraction is fraction of water fraction do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) !--- specify tsfcl/zorll from existing variable tsfco/zorlo @@ -1136,10 +1138,17 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) - if (Sfcprop(nb)%slmsk(ix) > 1.9) then - Sfcprop(nb)%landfrac(ix) = 0.0 + if (abs(1.0-Sfcprop(nb)%slmsk(ix)) < 0.1) then + Sfcprop(nb)%landfrac(ix) = 1.0 ! land + Sfcprop(nb)%lakefrac(ix) = 0.0 else - Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) + Sfcprop(nb)%landfrac(ix) = 0.0 ! water + if (Sfcprop(nb)%lakefrac(ix) > 0.0 .or. & + (Sfcprop(nb)%oro_uf(ix) > Model%min_lake_height .and. .not. Model%ignore_lake) ) then + Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake + else + Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean + endif endif enddo enddo diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index fef9698ab..85cdbf98b 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -14,7 +14,7 @@ module module_fcst_grid_comp !*** Forecast gridded component. !----------------------------------------------------------------------- !*** -!*** HISTORY +!*** HISTORY !*** ! Apr 2017: J. Wang - initial code for forecast grid component ! @@ -61,7 +61,7 @@ module module_fcst_grid_comp use data_override_mod, only: data_override_init use fv_nggps_diags_mod, only: fv_dyn_bundle_setup use fv3gfs_io_mod, only: fv_phys_bundle_setup - + use fms_io_mod, only: field_exist, read_data use atmosphere_mod, only: atmosphere_control_data @@ -530,9 +530,9 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if( cpl ) then call addLsmask2grid(fcstGrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! print *,'call addLsmask2grid after fcstgrid, rc=',rc +! print *,'call addLsmask2grid after fcstGrid, rc=',rc if( cplprint_flag ) then - call ESMF_GridWriteVTK(fcstgrid, staggerloc=ESMF_STAGGERLOC_CENTER, & + call ESMF_GridWriteVTK(fcstGrid, staggerloc=ESMF_STAGGERLOC_CENTER, & filename='fv3cap_fv3Grid', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif @@ -548,7 +548,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! Add dimension Attributes to Grid - call ESMF_AttributeAdd(fcstgrid, convention="NetCDF", purpose="FV3", & + call ESMF_AttributeAdd(fcstGrid, convention="NetCDF", purpose="FV3", & attrList=(/"ESMF:gridded_dim_labels"/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -616,7 +616,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call fv_dyn_bundle_setup(atm_int_state%Atm%axes, & - fieldbundle, fcstgrid, quilting, rc=rc) + fieldbundle, fcstGrid, quilting, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! Add the field to the importState so parent can connect to it @@ -639,7 +639,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) enddo ! call fv_phys_bundle_setup(atm_int_state%Atm%diag, atm_int_state%Atm%axes, & - fieldbundlephys, fcstgrid, quilting, nbdlphys) + fieldbundlephys, fcstGrid, quilting, nbdlphys) ! ! Add the field to the importState so parent can connect to it do j=1,nbdlphys @@ -857,7 +857,7 @@ subroutine fcst_finalize(fcst_comp, importState, exportState,clock,rc) ! integer :: unit integer,dimension(6) :: date - + real(8) mpi_wtime, tfs, tfe ! !----------------------------------------------------------------------- diff --git a/namphysics/NAM_layer/NAM_typedefs.F90 b/namphysics/NAM_layer/NAM_typedefs.F90 index 3dfa88530..09f8dca9d 100644 --- a/namphysics/NAM_layer/NAM_typedefs.F90 +++ b/namphysics/NAM_layer/NAM_typedefs.F90 @@ -325,7 +325,9 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ficein_cpl(:) => null() !< aoi_fld%ficein(item,lan) real (kind=kind_phys), pointer :: hicein_cpl(:) => null() !< aoi_fld%hicein(item,lan) real (kind=kind_phys), pointer :: hsnoin_cpl(:) => null() !< aoi_fld%hsnoin(item,lan) - !--- only variable needed for cplwav=.TRUE. + !--- only variable needed for cplwav2atm=.TRUE. + real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model + !--- also needed for ice/ocn coupling - Xingren real (kind=kind_phys), pointer :: slimskin_cpl(:)=> null() !< aoi_fld%slimskin(item,lan) @@ -453,6 +455,7 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection logical :: cplwav !< default no cplwav collection + logical :: cplwav2atm !< default no cplwav2atm coupling logical :: cplchm !< default no cplchm collection !--- integrated dynamics through earth's atmosphere @@ -1664,6 +1667,13 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%v10mi_cpl = clear_val endif + if (Model%cplwav2atm) then + !--- incoming quantities + allocate (Coupling%zorlwav_cpl (IM)) + + Coupling%zorlwav_cpl = clear_val + end if + if (Model%cplflx) then !--- incoming quantities allocate (Coupling%slimskin_cpl (IM)) @@ -1921,6 +1931,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection logical :: cplwav = .false. !< default no cplwav collection + logical :: cplwav2atm = .false. !< default no wav2atm coupling logical :: cplchm = .false. !< default no cplchm collection !--- integrated dynamics through earth's atmosphere @@ -2166,7 +2177,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & fhzero, ldiag3d, lssav, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplwav, cplchm, lsidea, & + cplflx, cplwav, cplwav2atm, cplchm, lsidea, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, aero_in, iflip, isol, ico2, ialb, & isot, iems, iaer, iovr_sw, iovr_lw, ictm, isubc_sw, & @@ -2362,6 +2373,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplwav = cplwav + Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm !--- integrated dynamics through earth's atmosphere @@ -3188,6 +3200,7 @@ subroutine control_print(Model) print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx print *, ' cplwav : ', Model%cplwav + print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm print *, ' ' print *, 'integrated dynamics through earth atmosphere'