From a0fb86dec6bf53301fae020f55e3ca61d0fd4eb9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 17 Oct 2019 18:54:18 +0000 Subject: [PATCH 01/32] github version of latest branch --- atmos_model.F90 | 30 +- fv3_cap.F90 | 6 +- gfsphysics/GFS_layer/GFS_driver.F90 | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 44 +-- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 16 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 34 +- gfsphysics/physics/cires_ugwp_initialize.F90 | 20 +- gfsphysics/physics/cires_ugwp_triggers.F90 | 52 +-- gfsphysics/physics/dcyc2.f | 2 +- gfsphysics/physics/gcm_shoc.f90 | 138 ++++---- gfsphysics/physics/gwdps.f | 20 +- gfsphysics/physics/sfc_nst.f | 4 +- gfsphysics/physics/sfc_sice.f | 2 +- gfsphysics/physics/ugwp_driver_v0.f | 326 +++++++++--------- io/FV3GFS_io.F90 | 9 +- 15 files changed, 360 insertions(+), 345 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 23e30e76c..620366227 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1566,6 +1566,7 @@ subroutine assign_importdata(rc) ! implicit none integer, intent(out) :: rc + real(kind=IPD_kind_phys), parameter :: epsln=1.0d-10 !--- local variables integer :: n, j, i, ix, nb, isc, iec, jsc, jec, dimCount, findex @@ -1652,7 +1653,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 @@ -1696,19 +1699,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) = datar8(i,j) -! 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 + if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) 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 @@ -1884,6 +1884,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) = max(IPD_Data(nb)%Coupling%tseain_cpl(ix), 271.2) IPD_Data(nb)%Sfcprop%fice(ix) = zero IPD_Data(nb)%Sfcprop%hice(ix) = zero IPD_Data(nb)%Sfcprop%snowd(ix) = zero @@ -1894,12 +1895,27 @@ 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 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 ! diff --git a/fv3_cap.F90 b/fv3_cap.F90 index e8e482099..657584e5e 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -30,7 +30,7 @@ module fv3gfs_cap_mod calendar, calendar_type, cpl, & force_date_from_configure, & cplprint_flag,output_1st_tstep_rst, & - first_kdt + first_kdt use module_fv3_io_def, only: num_pes_fcst,write_groups, & num_files, filename_base, & @@ -1274,7 +1274,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 @@ -1285,7 +1285,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 3b6a94336..e73343782 100644 --- a/gfsphysics/GFS_layer/GFS_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_driver.F90 @@ -445,7 +445,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 a54716960..76c6590d6 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2656,33 +2656,33 @@ subroutine GFS_physics_driver & if (ntgl > 0) then ! MG do k=1,levs do i=1,im - dqdt(i,k,1) = vdftra(i,k,1) - dqdt(i,k,ntcw) = vdftra(i,k,2) - dqdt(i,k,ntiw) = vdftra(i,k,3) - dqdt(i,k,ntrw) = vdftra(i,k,4) - dqdt(i,k,ntsw) = vdftra(i,k,5) - dqdt(i,k,ntgl) = vdftra(i,k,6) - dqdt(i,k,ntlnc) = vdftra(i,k,7) - dqdt(i,k,ntinc) = vdftra(i,k,8) - dqdt(i,k,ntrnc) = vdftra(i,k,9) - dqdt(i,k,ntsnc) = vdftra(i,k,10) - dqdt(i,k,ntgnc) = vdftra(i,k,11) - dqdt(i,k,ntoz) = vdftra(i,k,12) + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntgl) = dvdftra(i,k,6) + dqdt(i,k,ntlnc) = dvdftra(i,k,7) + dqdt(i,k,ntinc) = dvdftra(i,k,8) + dqdt(i,k,ntrnc) = dvdftra(i,k,9) + dqdt(i,k,ntsnc) = dvdftra(i,k,10) + dqdt(i,k,ntgnc) = dvdftra(i,k,11) + dqdt(i,k,ntoz) = dvdftra(i,k,12) enddo enddo else ! MG2 do k=1,levs do i=1,im - dqdt(i,k,1) = vdftra(i,k,1) - dqdt(i,k,ntcw) = vdftra(i,k,2) - dqdt(i,k,ntiw) = vdftra(i,k,3) - dqdt(i,k,ntrw) = vdftra(i,k,4) - dqdt(i,k,ntsw) = vdftra(i,k,5) - dqdt(i,k,ntlnc) = vdftra(i,k,6) - dqdt(i,k,ntinc) = vdftra(i,k,7) - dqdt(i,k,ntrnc) = vdftra(i,k,8) - dqdt(i,k,ntsnc) = vdftra(i,k,9) - dqdt(i,k,ntoz) = vdftra(i,k,10) + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntiw) = dvdftra(i,k,3) + dqdt(i,k,ntrw) = dvdftra(i,k,4) + dqdt(i,k,ntsw) = dvdftra(i,k,5) + dqdt(i,k,ntlnc) = dvdftra(i,k,6) + dqdt(i,k,ntinc) = dvdftra(i,k,7) + dqdt(i,k,ntrnc) = dvdftra(i,k,8) + dqdt(i,k,ntsnc) = dvdftra(i,k,9) + dqdt(i,k,ntoz) = dvdftra(i,k,10) enddo enddo endif diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index c7323d6bb..e912014ef 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -1871,30 +1871,30 @@ 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 do k = 1, LM 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 @@ -1910,7 +1910,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 @@ -1973,7 +1973,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 !> - Call module_radlw_main::lwrad(), to compute LW heating rates and diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 65f6d30de..7ea1b598f 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -228,12 +228,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 @@ -571,7 +571,7 @@ module GFS_typedefs logical :: cplchm !< default no cplchm collection !--- integrated dynamics through earth's atmosphere - logical :: lsidea + logical :: lsidea !vay 2018 GW physics switches @@ -865,7 +865,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 @@ -885,7 +885,7 @@ module GFS_typedefs 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 @@ -951,7 +951,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 @@ -2484,7 +2484,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 @@ -2881,6 +2881,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 @@ -2894,12 +2895,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) @@ -4896,12 +4896,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 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 9c8474ae4..1c33e4f3e 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..ff9391db1 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 @@ -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 @@ -449,7 +449,7 @@ subroutine shoc(ix, nx, nzm, nz, dtn, me, lat, & 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 +476,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 @@ -619,7 +619,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 +686,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 +744,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 +760,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 +781,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 +792,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 +812,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 +863,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 +889,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 +907,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 +916,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 +933,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 +957,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,7 +979,7 @@ 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 @@ -994,7 +993,7 @@ subroutine canuto() 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 @@ -1147,16 +1146,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 +1171,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 +1217,7 @@ subroutine assumed_pdf() else sqrtqt = zero endif - + ! Find parameters of the double Gaussian PDF of vertical velocity @@ -1256,7 +1255,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 +1265,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 +1283,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) @@ -1330,7 +1329,7 @@ subroutine assumed_pdf() qw1_2 = - corrtest2 / w1_1 ! A.8 tsign = abs(qw1_2-qw1_1) - + ! Skew_qw = skew_facw*Skew_w IF (tsign > 0.4) THEN @@ -1422,9 +1421,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 +1440,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) @@ -1579,9 +1578,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 +1587,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/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/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 804bbac19..cfc5505b1 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 @@ -79,7 +79,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 @@ -96,14 +96,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, @@ -120,7 +120,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 @@ -147,11 +147,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 @@ -184,7 +184,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) @@ -250,11 +250,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, @@ -300,7 +300,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 @@ -314,20 +314,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 @@ -345,21 +345,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" @@ -370,7 +370,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) @@ -381,9 +381,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 @@ -397,7 +397,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 @@ -407,7 +407,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) @@ -442,9 +442,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 @@ -465,13 +465,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 @@ -486,7 +486,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 @@ -504,38 +504,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) @@ -546,11 +546,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 ) ! @@ -586,18 +586,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) @@ -610,19 +610,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 @@ -632,24 +632,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) @@ -665,7 +665,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 @@ -676,7 +676,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 @@ -693,54 +693,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 @@ -748,7 +748,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 ! @@ -757,18 +757,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 ! @@ -845,7 +845,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 @@ -984,10 +984,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 ! @@ -998,11 +998,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, @@ -1027,23 +1027,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 @@ -1054,42 +1054,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. @@ -1234,8 +1234,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) @@ -1260,8 +1260,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 @@ -1275,15 +1275,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 @@ -1304,19 +1304,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 @@ -1326,7 +1326,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 @@ -1357,7 +1357,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 @@ -1369,13 +1369,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 @@ -1387,16 +1387,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 @@ -1418,7 +1418,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 @@ -1435,8 +1435,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)) @@ -1447,7 +1447,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 @@ -1470,7 +1470,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) @@ -1604,7 +1604,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! ------------------------------------------------------------- +! ------------------------------------------------------------- ! azimuth do-loop ! -------------------- do iazi=1, nazd @@ -1671,8 +1671,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 @@ -1700,7 +1700,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) @@ -1709,10 +1709,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 @@ -1735,7 +1735,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 @@ -1754,25 +1754,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) @@ -1788,7 +1788,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 @@ -1799,7 +1799,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 @@ -1814,9 +1814,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) @@ -1879,7 +1879,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 @@ -1899,7 +1899,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 ! @@ -1910,26 +1910,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 @@ -1981,7 +1981,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) @@ -1989,7 +1989,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, levs, & del(i,:), Sw, Sw1) @@ -1999,7 +1999,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) @@ -2021,10 +2021,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 6017f5fa6..a73a19084 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1106,7 +1106,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 @@ -1114,15 +1114,16 @@ 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) < 0.1 .or. Sfcprop(nb)%slmsk(ix) > 1.9) then + 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) = 0.0 if (Sfcprop(nb)%oro_uf(ix) > 0.01) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean endif - else - Sfcprop(nb)%landfrac(ix) = 1.0 ! land endif enddo enddo From 7ff47934ad5a8c412ab23fd3378f9b6ddd288efa Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Oct 2019 18:13:51 +0000 Subject: [PATCH 02/32] some fixes to physics driver --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 76c6590d6..d04bcae33 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 @@ -1108,7 +1109,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. @@ -1123,7 +1124,7 @@ subroutine GFS_physics_driver & fice(i) = zero endif endif - if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) +! if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) else fice(i) = zero endif @@ -1133,7 +1134,7 @@ subroutine GFS_physics_driver & if (tem1 > zero) then wet(i) = .true. ! there is some open water! ! 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 @@ -1154,7 +1155,7 @@ subroutine GFS_physics_driver & if (fice(i) < one) then wet(i) = .true. ! Sfcprop%tsfco(i) = tgice - Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) +! Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) ! Sfcprop%tsfco(i) = max((Sfcprop%tsfc(i) - fice(i)*sfcprop%tisfc(i)) & ! / (one - fice(i)), tgice) endif @@ -1740,7 +1741,7 @@ subroutine GFS_physics_driver & ! 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 From b9af9ee91916f2bf354afb030d231b142eb8c040 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Wed, 23 Oct 2019 01:44:51 +0000 Subject: [PATCH 03/32] adding import field of z0 surface roughness length and cplwav2atm flag for coupling wave to atm --- atmos_model.F90 | 21 +++++++++++++++++++++ cpl/module_cplfields.F90 | 11 +++++++---- gfsphysics/GFS_layer/GFS_typedefs.F90 | 16 ++++++++++++++-- namphysics/NAM_layer/NAM_typedefs.F90 | 17 +++++++++++++++-- 4 files changed, 57 insertions(+), 8 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 23e30e76c..0746b0fdb 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1641,6 +1641,27 @@ subroutine assign_importdata(rc) ! endif ! endif + +! get sea-state dependent surface roughness (if cplwav2atm=true) +!---------------------------- + fldname = 'wave_z0_roughness_length' + findex = QueryFieldList(ImportFieldsList,fldname) + if (importFieldsValid(findex) .and. datar8(isc,jsc) > -99999.0) then + if (trim(impfield_name) == trim(fldname) .and. found) 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) + IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = datar8(i,j) + enddo + enddo + endif + endif +!JDM TO DO: Coupling%zorlwav_cpl +! if ocean point with incoming wave z0 set +! IPD_Data(nb)%Sfcprop%zorl(ix) = IPD_Data(nb)%Coupling%zorlwav_cpl(ix) + ! get sea ice surface temperature !-------------------------------- fldname = 'sea_ice_surface_temperature' diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 48997ce4f..82c04cd2e 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -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/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 65f6d30de..471701623 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -415,7 +415,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) @@ -568,6 +569,7 @@ 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 @@ -2306,6 +2308,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)) @@ -2582,6 +2591,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 @@ -2940,7 +2950,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,& @@ -3121,6 +3131,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 @@ -4163,6 +4174,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' 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' From b65485fdf502ad30c9c9136358ec09e6a2b231e0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Oct 2019 17:14:56 +0000 Subject: [PATCH 04/32] removing 271.2 near line 1884 --- atmos_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 620366227..e8472bb68 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1884,7 +1884,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) = max(IPD_Data(nb)%Coupling%tseain_cpl(ix), 271.2) + 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 From 73e71f65f112426d43e6e9b872cadc1f5acfa072 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 24 Oct 2019 00:04:40 +0000 Subject: [PATCH 05/32] minor update of atmos_model.F90 --- atmos_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index e8472bb68..9f19aefd5 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1705,8 +1705,8 @@ subroutine assign_importdata(rc) IPD_Data(nb)%Coupling%ficein_cpl(ix) = datar8(i,j) 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 (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) 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 endif From b8bb84448cd24905d6beb89d6968373de047f08d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 28 Oct 2019 18:32:59 +0000 Subject: [PATCH 06/32] updating GFS_typedef for includeing ras in ccpp, plus minor mod in physics driver --- .gitmodules | 6 +++ gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 15 +++++--- gfsphysics/GFS_layer/GFS_typedefs.meta | 41 ++++++++++++++++++--- 4 files changed, 52 insertions(+), 12 deletions(-) diff --git a/.gitmodules b/.gitmodules index fb33a8b44..f8e75f557 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,3 +2,9 @@ path = atmos_cubed_sphere url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere branch = dev/emc +[submodule "ccpp/framework"] + path = ccpp/framework + url = https://github.com/NCAR/ccpp-framework +[submodule "ccpp/physics"] + path = ccpp/physics + url = https://github.com/SMoorthi-EMC/ccpp-physics diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index d04bcae33..c4aa7582c 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1155,7 +1155,7 @@ subroutine GFS_physics_driver & if (fice(i) < one) then wet(i) = .true. ! Sfcprop%tsfco(i) = tgice -! Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + if (.not. Model%cplflx) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) ! Sfcprop%tsfco(i) = max((Sfcprop%tsfc(i) - fice(i)*sfcprop%tisfc(i)) & ! / (one - fice(i)), tgice) endif diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 7ea1b598f..351c6510d 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1009,9 +1009,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 - integer :: 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 @@ -2865,7 +2865,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- 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) :: min_seaice = 1.0d-11 !< minimum sea ice value real(kind=kind_phys) :: rho_h2o = rhowater !< fresh water density !--- surface layer z0 scheme @@ -2905,7 +2905,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: iau_delthrs = 0 !< iau time interval (to scale increments) character(len=240) :: iau_inc_files(7) = '' !< list of increment files real(kind=kind_phys) :: iaufhrs(7) = -1 !< forecast hours associated with increment files - logical :: iau_filter_increments = .false. !< filter IAU increments + logical :: iau_filter_increments = .false.!< filter IAU increments !--- debug flag logical :: debug = .false. @@ -3617,6 +3617,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 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index f05354d7f..88fbc5a66 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -1977,6 +1977,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 @@ -1991,6 +2005,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 @@ -2308,12 +2336,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 @@ -2522,6 +2544,13 @@ standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag long_name = multiplication factors for cdmb and gwd units = none + 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 From c8840e9a20028920717aab1d8f728b32c445458c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 28 Oct 2019 23:22:10 +0000 Subject: [PATCH 07/32] after merging with Jessica's wave update in fv3 --- atmos_model.F90 | 22 +++++++++++----------- io/FV3GFS_io.F90 | 2 +- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index d7a0fc23b..a65a348c1 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1645,20 +1645,20 @@ subroutine assign_importdata(rc) ! get sea-state dependent surface roughness (if cplwav2atm=true) !---------------------------- - fldname = 'wave_z0_roughness_length' - findex = QueryFieldList(ImportFieldsList,fldname) - if (importFieldsValid(findex) .and. datar8(isc,jsc) > -99999.0) then - if (trim(impfield_name) == trim(fldname) .and. found) then + fldname = 'wave_z0_roughness_length' + if (trim(impfield_name) == trim(fldname)) then + findex = QueryFieldList(ImportFieldsList,fldname) + if (importFieldsValid(findex)) 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) - IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = datar8(i,j) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = datar8(i,j) + enddo enddo - enddo + endif endif - endif !JDM TO DO: Coupling%zorlwav_cpl ! if ocean point with incoming wave z0 set ! IPD_Data(nb)%Sfcprop%zorl(ix) = IPD_Data(nb)%Coupling%zorlwav_cpl(ix) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index a73a19084..990c670d1 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1119,7 +1119,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%lakefrac(ix) = 0.0 else Sfcprop(nb)%landfrac(ix) = 0.0 - if (Sfcprop(nb)%oro_uf(ix) > 0.01) then + if (Sfcprop(nb)%oro_uf(ix) > 1.00) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean From 6f86c4bf03438373086cbecb48966ba5b37048d6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 2 Nov 2019 23:48:10 +0000 Subject: [PATCH 08/32] coupling with ww3 --- atmos_model.F90 | 14 ++++--- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 26 ++++++------ gfsphysics/GFS_layer/GFS_typedefs.F90 | 2 + gfsphysics/physics/sfc_diff.f | 44 +++++++++++---------- io/FV3GFS_io.F90 | 2 +- 5 files changed, 49 insertions(+), 39 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index a65a348c1..c4df8bfe4 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1575,6 +1575,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 ! !------------------------------------------------------------------------------ @@ -1648,20 +1649,22 @@ subroutine assign_importdata(rc) fldname = 'wave_z0_roughness_length' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) - if (importFieldsValid(findex)) then + 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) - IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = datar8(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 -!JDM TO DO: Coupling%zorlwav_cpl -! if ocean point with incoming wave z0 set -! IPD_Data(nb)%Sfcprop%zorl(ix) = IPD_Data(nb)%Coupling%zorlwav_cpl(ix) ! get sea ice surface temperature !-------------------------------- @@ -1921,6 +1924,7 @@ subroutine assign_importdata(rc) enddo enddo endif +! !------------------------------------------------------------------------------- ! do j=jsc,jec ! do i=isc,iec diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index c4aa7582c..6866a0b19 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1129,9 +1129,7 @@ subroutine GFS_physics_driver & 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 (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), tgice) ! if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) @@ -1197,11 +1195,16 @@ subroutine GFS_physics_driver & ! DH* In CCPP, this is in GFS_surface_composites_pre 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 @@ -1680,7 +1683,7 @@ subroutine GFS_physics_driver & if (Model%cplflx) then 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 @@ -1691,7 +1694,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 @@ -1735,8 +1738,7 @@ 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 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index fa39570c4..acce1bfa7 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -2883,6 +2883,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< 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 @@ -3423,6 +3424,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- 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 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/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 990c670d1..f1adc58f7 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1119,7 +1119,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%lakefrac(ix) = 0.0 else Sfcprop(nb)%landfrac(ix) = 0.0 - if (Sfcprop(nb)%oro_uf(ix) > 1.00) then + if (Sfcprop(nb)%oro_uf(ix) > 25.00) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean From ac9195cab5b55478d8a465dcee5f34672e63fd08 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 6 Nov 2019 00:24:19 +0000 Subject: [PATCH 09/32] after merging with fv3atm develop branch and updating for ras --- atmos_cubed_sphere | 2 +- ccpp/config/ccpp_prebuild_config.py | 1 + ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 6 ------ 4 files changed, 3 insertions(+), 8 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 8dd7628b3..786447c83 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 8dd7628b3e2d1db8a48d877b9fe561be66bbf472 +Subproject commit 786447c8391a6806cd7b869bfa9dca69e3c95a48 diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index b1738d633..e5f607fcc 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -213,6 +213,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 d4b1cd020..51c13beef 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d4b1cd020f8347147b86d3a18b56c03cb5c57d67 +Subproject commit 51c13beef8b36036b5a9ac34b7951fe20b1d4eb2 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index c39713b0e..ec8be1620 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1017,15 +1017,9 @@ module GFS_typedefs #endif integer :: jdat(1:8) !< current forecast date and time !< (yr, mon, day, t-zone, hr, min, sec, mil-sec) -<<<<<<< HEAD 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 -======= - integer :: imn !< current forecast month - real(kind=kind_phys) :: julian !< current forecast julian date - integer :: yearlen !< current length of the year ->>>>>>> 45dbc34bdb8cf2d6d3ed1fc0b0067d00be8422d8 ! logical :: iccn !< using IN CCN forcing for MG2/3 #ifdef CCPP From 393bc62808bcc5104e7f18ad97e1b5d8edde08c5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 29 Dec 2019 00:37:54 +0000 Subject: [PATCH 10/32] FV3 updates for RAS MG3 SHOC so that IPD and CCPP reproduce in REPRO mode --- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_rasmgshoc.xml | 91 +++++ ccpp/suites/suite_FV3_GFS_v15.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_ras.xml | 93 +++++ ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml | 88 ++++ ccpp/suites/suite_FV3_GFS_v15plusras.xml | 94 +++++ gfsphysics/GFS_layer/GFS_driver.F90 | 4 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 432 +++++++++++--------- gfsphysics/GFS_layer/GFS_typedefs.F90 | 69 ++-- gfsphysics/GFS_layer/GFS_typedefs.meta | 6 + gfsphysics/physics/gcm_shoc.f90 | 69 ++-- gfsphysics/physics/m_micro_driver.F90 | 29 +- 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/ugwp_driver_v0.f | 4 +- io/FV3GFS_io.F90 | 2 +- 19 files changed, 969 insertions(+), 458 deletions(-) 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/ccpp/physics b/ccpp/physics index 51c13beef..62fb748a3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 51c13beef8b36036b5a9ac34b7951fe20b1d4eb2 +Subproject commit 62fb748a3cacaa78e34dea5f1791eaed91af9094 diff --git a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml new file mode 100644 index 000000000..4f05dce54 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml @@ -0,0 +1,91 @@ + + + + + + + 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 + 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 672c39280..0bbe186f5 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_ras.xml b/ccpp/suites/suite_FV3_GFS_v15_ras.xml new file mode 100644 index 000000000..e715206f9 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15_ras.xml @@ -0,0 +1,93 @@ + + + + + + + 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 + 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..93f3abac9 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15_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 + 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 + 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_v15plusras.xml b/ccpp/suites/suite_FV3_GFS_v15plusras.xml new file mode 100644 index 000000000..0bb4b21a5 --- /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 + dcyc2t3_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 + 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/gfsphysics/GFS_layer/GFS_driver.F90 b/gfsphysics/GFS_layer/GFS_driver.F90 index e73343782..21c9f2d7a 100644 --- a/gfsphysics/GFS_layer/GFS_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_driver.F90 @@ -332,7 +332,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, & @@ -345,7 +345,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, & diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index b28adc377..c0acf1868 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -818,8 +818,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) & @@ -1977,8 +1981,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) @@ -2265,12 +2269,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) @@ -2722,7 +2730,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) @@ -3165,10 +3174,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,:) @@ -3231,6 +3240,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 @@ -3352,6 +3362,11 @@ subroutine GFS_physics_driver & enddo rhc(:,:) = one 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 ! @@ -3409,6 +3424,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 @@ -3447,6 +3464,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 @@ -3457,7 +3475,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 @@ -3753,8 +3771,8 @@ subroutine GFS_physics_driver & ! trcmin) trcmin, ntk) -! 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) @@ -3864,6 +3882,12 @@ 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 if (Model%do_cnvgwd) then ! call convective gravity wave drag @@ -4049,6 +4073,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 @@ -4101,6 +4130,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 call samfshalcnv (im, ix, levs, dtp, itc, Model%ntchm, ntk, nsamftrac, & del, Statein%prsl, Statein%pgr, Statein%phil, clw, & Stateout%gq0(:,:,1), Stateout%gt0, & @@ -4308,6 +4341,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 @@ -4369,6 +4403,16 @@ subroutine GFS_physics_driver & enddo endif ! end if_ntcw +! 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 call cnvc90 (Model%clstp, im, ix, Diag%rainc, kbot, ktop, levs, Statein%prsi, & @@ -4563,97 +4607,97 @@ subroutine GFS_physics_driver & ims,ime, kms,kme, & its,ite, kts,kte) ! - elseif (imp_physics == Model%imp_physics_mg) then ! MGB double-moment microphysics + elseif (imp_physics == Model%imp_physics_mg) then ! MGB double-moment microphysics ! ------------------------------ - kk = 5 - if (Model%fprcp >= 2) kk = 6 + kk = 5 + if (Model%fprcp >= 2) kk = 6 ! 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 ! in other procceses too. August 28/2015; Hope that can be done next ! year. I believe this will make the physical interaction more reasonable ! Anning 12/5/2015 changed ntcw hold liquid only - 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 ! notice clw ix instead of im ! call m_micro_driver(im,ix,levs,flipv,del,dtp,prsl,prsi, @@ -4662,6 +4706,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 @@ -4676,30 +4721,30 @@ subroutine GFS_physics_driver & ! write(1000+me,*)' maxwatncb=',maxval(Stateout%gq0(1:im,k,ntlnc)),' k=',k,' kdt',kdt ! enddo - 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) ! do k=1,levs ! write(1000+me,*)' maxwatnca=',maxval(Stateout%gq0(1:im,k,ntlnc)),' k=',k,' kdt=',kdt ! enddo @@ -4719,7 +4764,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 @@ -4728,43 +4773,43 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt - 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 + 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 @@ -4830,20 +4875,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 @@ -4883,7 +4928,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)) @@ -4891,25 +4936,25 @@ subroutine GFS_physics_driver & endif enddo !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 ! if(Model%effr_in) then call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), & @@ -4922,22 +4967,22 @@ subroutine GFS_physics_driver & Tbd%phy_f3d(1:im,1:levs,3), Tbd%phy_f3d(1:im,1:levs,4), & Tbd%phy_f3d(1:im,1:levs,5)) -! do k = 1, levs -! do i=1,im +! 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 +! 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 @@ -4995,7 +5040,7 @@ subroutine GFS_physics_driver & enddo endif - Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) + Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) ! total rain per timestep if (Model%cal_pre) then ! hchuang: add dominant precipitation type algorithm ! @@ -5124,6 +5169,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 @@ -5277,7 +5323,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_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index ec8be1620..143d91dfc 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -659,9 +659,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) @@ -670,11 +668,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 @@ -2579,18 +2575,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 @@ -2711,9 +2705,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 @@ -2721,10 +2713,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. @@ -2886,6 +2876,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 @@ -3024,12 +3017,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, & @@ -3289,9 +3278,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 @@ -3312,11 +3299,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 @@ -3381,12 +3366,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 @@ -3443,7 +3428,8 @@ 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 + + Model%do_cnvgwd = Model%cnvgwd .and. (maxval(Model%cdmbgwd(3:4)) == 0.0 .and. .not. Model%do_ugwp) #ifdef CCPP Model%do_mynnedmf = do_mynnedmf Model%do_mynnsfclay = do_mynnsfclay @@ -3759,15 +3745,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 @@ -3981,7 +3967,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' @@ -4340,6 +4326,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 @@ -5280,8 +5267,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 @@ -5999,6 +5986,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 @@ -6014,7 +6002,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 @@ -6169,9 +6158,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 fbe232e52..2154aa5bb 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -1948,6 +1948,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) diff --git a/gfsphysics/physics/gcm_shoc.f90 b/gfsphysics/physics/gcm_shoc.f90 index ff9391db1..4693131ac 100644 --- a/gfsphysics/physics/gcm_shoc.f90 +++ b/gfsphysics/physics/gcm_shoc.f90 @@ -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 @@ -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,6 +449,11 @@ 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() @@ -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 @@ -985,8 +998,8 @@ subroutine canuto() 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), & @@ -1040,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 @@ -1328,6 +1340,9 @@ 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 @@ -1397,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 @@ -1460,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)) @@ -1473,13 +1492,13 @@ 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 - ELSEIF (s1 >= qcmin) THEN - C1 = one - qn1 = s1 +!! ELSEIF (s1 >= qcmin) THEN +!! C1 = one +!! qn1 = s1 ENDIF ! now compute non-precipitating cloud condensate @@ -1512,9 +1531,9 @@ subroutine assumed_pdf() wrk = s2 / (std_s2*sqrt2) C2 = max(zero, min(one, half*(one+erf(wrk)))) IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) - ELSEIF (s2 >= qcmin) THEN - C2 = one - qn2 = s2 +!! ELSEIF (s2 >= qcmin) THEN +!! C2 = one +!! qn2 = s2 ENDIF ENDIF @@ -1551,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 diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 9d4d3a318..9d6e8be7a 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 @@ -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/ugwp_driver_v0.f b/gfsphysics/physics/ugwp_driver_v0.f index cfc5505b1..dd3a3e2d0 100644 --- a/gfsphysics/physics/ugwp_driver_v0.f +++ b/gfsphysics/physics/ugwp_driver_v0.f @@ -46,7 +46,9 @@ subroutine cires_ugwp_driver_v0(me, master, &, rain real(kind=kind_phys), intent(in), dimension(im,levs) :: ugrs - &, vgrs, tgrs, qgrs, prsi, prsl, prslk, phii, phil, del + &, vgrs, tgrs, qgrs, prsl, prslk, phil, del + real(kind=kind_phys), intent(in), dimension(im,levs+1) :: prsi + &, phii ! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 8dcb9ac88..74c0554a3 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1124,7 +1124,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%lakefrac(ix) = 0.0 else Sfcprop(nb)%landfrac(ix) = 0.0 - if (Sfcprop(nb)%oro_uf(ix) > 25.00) then + if (Sfcprop(nb)%oro_uf(ix) > 200.00) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean From 3037555e50e95ecca2f9976bfb3e448ee9559ad6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 30 Dec 2019 17:36:00 +0000 Subject: [PATCH 11/32] updating mg driver, physics driver and typedef --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 4 ++-- gfsphysics/GFS_layer/GFS_typedefs.F90 | 2 +- gfsphysics/physics/m_micro_driver.F90 | 8 ++++---- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index c0acf1868..454750825 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -3240,7 +3240,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 /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -4341,7 +4341,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 /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 143d91dfc..4b6de8660 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -5986,7 +5986,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%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 diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 9d6e8be7a..26a04d96a 100644 --- a/gfsphysics/physics/m_micro_driver.F90 +++ b/gfsphysics/physics/m_micro_driver.F90 @@ -408,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 From 86801388548ed58db7d3b186f596df8a9154c0b7 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 30 Dec 2019 17:47:17 +0000 Subject: [PATCH 12/32] updating gcm_shoc.f90 to turn on commented code in assumed pdf --- gfsphysics/physics/gcm_shoc.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/gfsphysics/physics/gcm_shoc.f90 b/gfsphysics/physics/gcm_shoc.f90 index 4693131ac..f5791a049 100644 --- a/gfsphysics/physics/gcm_shoc.f90 +++ b/gfsphysics/physics/gcm_shoc.f90 @@ -1496,9 +1496,9 @@ subroutine assumed_pdf() ! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 -!! ELSEIF (s1 >= qcmin) THEN -!! C1 = one -!! qn1 = s1 + ELSEIF (s1 >= qcmin) THEN + C1 = one + qn1 = s1 ENDIF ! now compute non-precipitating cloud condensate @@ -1531,9 +1531,9 @@ subroutine assumed_pdf() wrk = s2 / (std_s2*sqrt2) C2 = max(zero, min(one, half*(one+erf(wrk)))) IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) -!! ELSEIF (s2 >= qcmin) THEN -!! C2 = one -!! qn2 = s2 + ELSEIF (s2 >= qcmin) THEN + C2 = one + qn2 = s2 ENDIF ENDIF From 4cd482f81c5bf783f6fc468a2abde0cfde7b629c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 8 Jan 2020 20:23:08 +0000 Subject: [PATCH 13/32] constraing imported ice fraction in atmos_model.F90 --- .gitmodules | 2 +- atmos_cubed_sphere | 2 +- atmos_model.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index f8e75f557..cbde527f8 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere + url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 0e84f88b4..a56907a44 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 0e84f88b494b9e0a4097da50abe6b143330e8a2f +Subproject commit a56907a44461c7151e0ba266e160c8f1a1685882 diff --git a/atmos_model.F90 b/atmos_model.F90 index 6ec74d33f..3079d512c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1748,7 +1748,7 @@ subroutine assign_importdata(rc) 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) = datar8(i,j) + IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(datar8(i,j),one)) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4. elseif (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then From 3fe1183e53019f69d6ed5888b215b88a2f6649fb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 10 Jan 2020 15:15:54 +0000 Subject: [PATCH 14/32] after merging with NOAA-EMC/fv3atm/develop --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index a56907a44..8dd7628b3 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit a56907a44461c7151e0ba266e160c8f1a1685882 +Subproject commit 8dd7628b3e2d1db8a48d877b9fe561be66bbf472 From 826bba973bc11a607bed3c4719ae7abd4479fe9d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 11 Jan 2020 01:03:38 +0000 Subject: [PATCH 15/32] minor fix to atmos_model.F90 and IPD physics driver --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 1 + gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index a56907a44..0e84f88b4 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit a56907a44461c7151e0ba266e160c8f1a1685882 +Subproject commit 0e84f88b494b9e0a4097da50abe6b143330e8a2f diff --git a/atmos_model.F90 b/atmos_model.F90 index 3079d512c..3d221e61c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1941,6 +1941,7 @@ 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 ! ,, + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero endif endif enddo diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 0d970e789..92bbe64cb 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2059,7 +2059,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) From 2425771a902ed3b617fe6a70cbb4ee7fb7ec7aa5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 13 Jan 2020 18:58:15 +0000 Subject: [PATCH 16/32] updating .gitmodules --- .gitmodules | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitmodules b/.gitmodules index cbde527f8..550c2fbf1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,3 +8,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics + branch = SM_Jan102020 From e2fea18a22507f584ac14e541012910248cb4e92 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 14 Jan 2020 01:04:11 +0000 Subject: [PATCH 17/32] adding two couplrd suites --- ccpp/suites/suite_FV3_GFS_2017_coupled.xml | 2 +- ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml | 88 ++++++++++++++++++ .../suite_FV3_GFS_cpldnst_rasmgshoc.xml | 90 +++++++++++++++++++ 3 files changed, 179 insertions(+), 1 deletion(-) create mode 100644 ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml create mode 100644 ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml b/ccpp/suites/suite_FV3_GFS_2017_coupled.xml index 31a744176..4dc7e3851 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_coupled.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_coupled.xml @@ -57,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_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 + + + + From 15e0c25c0d560217cb2c9e9e9e547c4b052ce099 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 16 Jan 2020 15:59:55 +0000 Subject: [PATCH 18/32] 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 --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 3 ++- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 5 ++--- gfsphysics/GFS_layer/GFS_typedefs.F90 | 10 +++++++--- io/FV3GFS_io.F90 | 6 ++++-- 6 files changed, 17 insertions(+), 11 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 0e84f88b4..a56907a44 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 0e84f88b494b9e0a4097da50abe6b143330e8a2f +Subproject commit a56907a44461c7151e0ba266e160c8f1a1685882 diff --git a/atmos_model.F90 b/atmos_model.F90 index 3d221e61c..42d78d00b 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1941,7 +1941,8 @@ 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 ! ,, - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero + if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) & + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero ! 100% open water endif endif enddo diff --git a/ccpp/physics b/ccpp/physics index 647a9cf5e..372bd9d48 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 647a9cf5e91764fc2adb3bcbf4f3f33e54233f7a +Subproject commit 372bd9d48c3d5ef4c315ecab812fa96b00fed547 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 6ffbbf13b..4be44ab22 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1146,13 +1146,13 @@ 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 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) endif @@ -1720,7 +1720,7 @@ 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) .and. Sfcprop%oceanfrac(i) > zero) then @@ -5462,7 +5462,6 @@ subroutine GFS_physics_driver & endif - ! --- ... coupling insertion if (Model%cplflx .or. Model%cplchm) then diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index dfa7d73ba..10b7cb783 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -927,6 +927,7 @@ 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 real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value real(kind=kind_phys) :: rho_h2o !< density of fresh water @@ -3019,6 +3020,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid = .false. !< flag for fractional grid + logical :: frac_grid_off = .true. !< flag for using fractional grid 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) :: rho_h2o = rhowater !< fresh water density @@ -3159,7 +3161,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- near surface sea temperature model nst_anl, lsea, nstf_name, & frac_grid, min_lakeice, min_seaice, & - frac_grid, & + frac_grid_off, & !--- surface layer sfc_z0_type, & ! background vertical diffusion @@ -3587,10 +3589,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- fractional grid Model%frac_grid = frac_grid + Model%frac_grid_off = frac_grid_off #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 @@ -3969,7 +3972,8 @@ 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 *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,& + ' frac_grid_off=',frac_grid_off print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice if (Model%nstf_name(1) > 0 ) then print *,' NSSTM is active ' diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index a72b86d73..25d0694d0 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 @@ -1140,8 +1142,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%landfrac(ix) = 1.0 ! land Sfcprop(nb)%lakefrac(ix) = 0.0 else - Sfcprop(nb)%landfrac(ix) = 0.0 - if (Sfcprop(nb)%oro_uf(ix) > 200.00) then + Sfcprop(nb)%landfrac(ix) = 0.0 ! water + if (Sfcprop(nb)%lakefrac(ix) > 0.0 .or. Sfcprop(nb)%oro_uf(ix) > 250.0) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean From efe2053d901c77652543ad8557135e6817030bd8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Jan 2020 11:36:53 +0000 Subject: [PATCH 19/32] adding con_csol to GFS_typedefs.F90 and GFS_typedefs.meta for CCPP --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 3 ++- gfsphysics/GFS_layer/GFS_typedefs.meta | 9 +++++++++ 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 372bd9d48..06aeee65e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 372bd9d48c3d5ef4c315ecab812fa96b00fed547 +Subproject commit 06aeee65e2f084acba2340a1245f1722df26eaf4 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 10b7cb783..c31c55d0d 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 diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index 3b3e2071d..21e2e4deb 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -8607,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 From 6a4acdc9876853ebdc2943b6ebf124e899191e7d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 30 Jan 2020 17:33:43 -0700 Subject: [PATCH 20/32] Update long names of hydrometeors to match the ccpp-physics change --- gfsphysics/GFS_layer/GFS_typedefs.meta | 40 +++++++++++++------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index 21e2e4deb..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 @@ -6217,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 @@ -6448,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 @@ -7490,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 @@ -7518,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 @@ -7657,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 From 9cf67326efe155149ecb9d6ff9e7bfde2026ef65 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 1 Feb 2020 01:04:21 +0000 Subject: [PATCH 21/32] reverting white space changes in .gitmodules --- .gitmodules | 8 ++++---- ccpp/physics | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 550c2fbf1..75cde6477 100644 --- a/.gitmodules +++ b/.gitmodules @@ -3,9 +3,9 @@ url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] - path = ccpp/framework - url = https://github.com/NCAR/ccpp-framework + path = ccpp/framework + url = https://github.com/NCAR/ccpp-framework [submodule "ccpp/physics"] - path = ccpp/physics - url = https://github.com/SMoorthi-EMC/ccpp-physics + path = ccpp/physics + url = https://github.com/SMoorthi-EMC/ccpp-physics branch = SM_Jan102020 diff --git a/ccpp/physics b/ccpp/physics index 06aeee65e..b7e321b89 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 06aeee65e2f084acba2340a1245f1722df26eaf4 +Subproject commit b7e321b89dd6ddb724c6acd15108e87a6244c0e6 From 84c738e3c55ab3fb6844538f094d4f2761395574 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 Feb 2020 00:39:20 +0000 Subject: [PATCH 22/32] adding ignore_lake flag to GFS_typedefs.F90 andFV3GFS_io.F90 to preserve the option used in current s2s benchmarks --- gfsphysics/GFS_layer/GFS_typedefs.F90 | 7 +++++-- io/FV3GFS_io.F90 | 3 ++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index c31c55d0d..d6e8ac1d0 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -929,6 +929,7 @@ module GFS_typedefs !--- 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) :: rho_h2o !< density of fresh water @@ -3022,6 +3023,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- fractional grid 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) :: rho_h2o = rhowater !< fresh water density @@ -3162,7 +3164,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- near surface sea temperature model nst_anl, lsea, nstf_name, & frac_grid, min_lakeice, min_seaice, & - frac_grid_off, & + frac_grid_off, ignore_lake, & !--- surface layer sfc_z0_type, & ! background vertical diffusion @@ -3591,6 +3593,7 @@ 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" @@ -3974,7 +3977,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,& - ' frac_grid_off=',frac_grid_off + ' frac_grid_off=',frac_grid_off,' ignore_lake=',ignore_lake print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice if (Model%nstf_name(1) > 0 ) then print *,' NSSTM is active ' diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 25d0694d0..7119f7508 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1143,7 +1143,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%lakefrac(ix) = 0.0 else Sfcprop(nb)%landfrac(ix) = 0.0 ! water - if (Sfcprop(nb)%lakefrac(ix) > 0.0 .or. Sfcprop(nb)%oro_uf(ix) > 250.0) then + if (Sfcprop(nb)%lakefrac(ix) > 0.0 .or. & + (Sfcprop(nb)%oro_uf(ix) > 250.0 .and. .not. Model%ignore_lake) ) then Sfcprop(nb)%lakefrac(ix) = 1.0 ! lake else Sfcprop(nb)%lakefrac(ix) = 0.0 ! ocean From 4eee1847d9b47a9c39809d3011c527d5a8bbda9e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Feb 2020 00:51:08 +0000 Subject: [PATCH 23/32] 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 --- atmos_model.F90 | 46 +++++++++++---------- ccpp/physics | 2 +- cpl/module_cap_cpl.F90 | 8 +++- cpl/module_cplfields.F90 | 12 +++--- fv3_cap.F90 | 14 ++++--- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 23 +++++++---- module_fcst_grid_comp.F90 | 16 +++---- 7 files changed, 68 insertions(+), 53 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 42d78d00b..a34f3950f 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, & + puny = 1.0e-12_IPD_kind_phys contains @@ -1666,7 +1667,7 @@ subroutine assign_importdata(rc) ! endif -! get sea-state dependent surface roughness (if cplwav2atm=true) +! get sea-state dependent surface roughness (if cplwav2atm=true) !---------------------------- fldname = 'wave_z0_roughness_length' if (trim(impfield_name) == trim(fldname)) then @@ -1764,7 +1765,7 @@ subroutine assign_importdata(rc) ! get upward LW flux: for sea ice covered area !---------------------------------------------- - fldname = 'mean_up_lw_flx' + fldname = 'mean_up_lw_flx_ice' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then @@ -1791,7 +1792,7 @@ subroutine assign_importdata(rc) ! get latent heat flux: for sea ice covered area !------------------------------------------------ - fldname = 'mean_laten_heat_flx' + fldname = 'mean_laten_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then @@ -1811,7 +1812,7 @@ subroutine assign_importdata(rc) ! get sensible heat flux: for sea ice covered area !-------------------------------------------------- - fldname = 'mean_sensi_heat_flx' + fldname = 'mean_sensi_heat_flx_atm_into_ice' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then @@ -1831,7 +1832,7 @@ subroutine assign_importdata(rc) ! get zonal compt of momentum flux: for sea ice covered area !------------------------------------------------------------ - fldname = 'mean_zonal_moment_flx' + fldname = 'stress_on_air_ice_zonal' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then @@ -1851,7 +1852,7 @@ subroutine assign_importdata(rc) ! get meridional compt of momentum flux: for sea ice covered area !----------------------------------------------------------------- - fldname = 'mean_merid_moment_flx' + fldname = 'stress_on_air_ice_merid' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then @@ -2542,7 +2543,8 @@ subroutine setup_exportdata (rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - exportData(i,j,idx) = IPD_Data(nb)%coupling%slmsk_cpl(ix) +! exportData(i,j,idx) = IPD_Data(nb)%coupling%slmsk_cpl(ix) + exportData(i,j,idx) = floor(one + puny - IPD_Data(nb)%SfcProp%oceanfrac(ix)) enddo enddo endif @@ -2561,7 +2563,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 @@ -2579,7 +2581,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 @@ -2630,7 +2632,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 @@ -2646,8 +2648,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 @@ -2666,14 +2668,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 @@ -2706,12 +2708,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 @@ -2719,7 +2721,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 @@ -2734,16 +2736,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 + puny - 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) @@ -2752,7 +2754,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/physics b/ccpp/physics index b7e321b89..8a8de1740 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit b7e321b89dd6ddb724c6acd15108e87a6244c0e6 +Subproject commit 8a8de1740807e24a9e7198fad48414845347b205 diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 3e858c0e0..a9c15ac9a 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -102,7 +102,7 @@ subroutine realizeConnectedCplFields(state, grid, numLevels, numSoilLayers, numTracers, & num_diag_sfc_emis_flux, num_diag_down_flux, & num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, fieldNames, fieldTypes, fieldList, rc) + num_diag_cmass, fieldNames, fieldTypes, fieldList, tag, rc) type(ESMF_State), intent(inout) :: state type(ESMF_Grid), intent(in) :: grid @@ -117,6 +117,7 @@ subroutine realizeConnectedCplFields(state, grid, character(len=*), dimension(:), intent(in) :: fieldNames character(len=*), dimension(:), intent(in) :: fieldTypes type(ESMF_Field), dimension(:), intent(out) :: fieldList + character(len=*), intent(in) :: tag !< Import or export. integer, intent(out) :: rc ! local variables @@ -196,10 +197,15 @@ subroutine realizeConnectedCplFields(state, grid, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! -- save field fieldList(item) = field + call ESMF_LogWrite('realizeConnectedCplFields '//trim(tag)//' Field '//trim(fieldNames(item))// ' is connected ', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) else ! remove a not connected Field from State call ESMF_StateRemove(state, (/trim(fieldNames(item))/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite('realizeConnectedCplFields '//trim(tag)//' Field '//trim(fieldNames(item))// ' is not connected ', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) end if end do diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 82c04cd2e..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 ", & @@ -152,12 +152,12 @@ module module_cplfields ! "inst_ice_ir_dir_albedo ", & ! "inst_ice_vis_dif_albedo ", & ! "inst_ice_vis_dir_albedo ", & - "mean_up_lw_flx ", & - "mean_laten_heat_flx ", & - "mean_sensi_heat_flx ", & + "mean_up_lw_flx_ice ", & + "mean_laten_heat_flx_atm_into_ice ", & + "mean_sensi_heat_flx_atm_into_ice ", & ! "mean_evap_rate ", & - "mean_zonal_moment_flx ", & - "mean_merid_moment_flx ", & + "stress_on_air_ice_zonal ", & + "stress_on_air_ice_merid ", & "mean_ice_volume ", & "mean_snow_volume ", & "inst_tracer_up_surface_flx ", & diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 9fc6ea718..1c54558d1 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -880,14 +880,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call realizeConnectedCplFields(exportState, fcstGrid, & numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, exportFieldsList, exportFieldTypes, exportFields, rc) + num_diag_cmass, exportFieldsList, exportFieldTypes, exportFields, & + 'FV3 Export',rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! -- realize connected fields in importState call realizeConnectedCplFields(importState, fcstGrid, & numLevels, numSoilLayers, numTracers, num_diag_sfc_emis_flux, & num_diag_down_flux, num_diag_type_down_flux, num_diag_burn_emis_flux, & - num_diag_cmass, importFieldsList, importFieldTypes, importFields, rc) + num_diag_cmass, importFieldsList, importFieldTypes, importFields, & + 'FV3 Import',rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if endif @@ -946,7 +948,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 !----------------------------------------------------------------------- @@ -1001,7 +1003,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 @@ -1236,7 +1238,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 @@ -1258,7 +1260,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 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 4be44ab22..cf8a1527c 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2216,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 @@ -2843,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)) @@ -2878,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 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 ! !----------------------------------------------------------------------- From 28a55c1969b0fefcf2defa5b8704995b14f07b67 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Feb 2020 14:01:57 +0000 Subject: [PATCH 24/32] changing variable puny to epsln in atmos_model.F90 on Denise's recommendation --- atmos_model.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index a34f3950f..644326d2c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -224,7 +224,7 @@ module atmos_model_mod real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, & one = 1.0_IPD_kind_phys, & - puny = 1.0e-12_IPD_kind_phys + epsln = 1.0e-12_IPD_kind_phys contains @@ -2544,7 +2544,7 @@ subroutine setup_exportdata (rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) ! exportData(i,j,idx) = IPD_Data(nb)%coupling%slmsk_cpl(ix) - exportData(i,j,idx) = floor(one + puny - IPD_Data(nb)%SfcProp%oceanfrac(ix)) + exportData(i,j,idx) = floor(one + epsln - IPD_Data(nb)%SfcProp%oceanfrac(ix)) enddo enddo endif @@ -2736,7 +2736,7 @@ 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(one + puny - IPD_Data(nb)%SfcProp%oceanfrac(ix)) + lsmask(i,j) = floor(one + epsln - IPD_Data(nb)%SfcProp%oceanfrac(ix)) enddo enddo ! From 66e862219367b0aa72660f057269fe132892818d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 11 Feb 2020 19:11:30 +0000 Subject: [PATCH 25/32] added a new namelist parameter, min_lake_height, with default value of 250m, changeable by user to give more generality --- gfsphysics/GFS_layer/GFS_typedefs.F90 | 20 ++++++++++++-------- io/FV3GFS_io.F90 | 2 +- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index d6e8ac1d0..18f6f2c49 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -932,6 +932,7 @@ module GFS_typedefs 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 @@ -3021,12 +3022,13 @@ 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 - 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) :: 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 @@ -3163,7 +3165,7 @@ 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, min_lakeice, min_seaice, min_lake_height, & frac_grid_off, ignore_lake, & !--- surface layer sfc_z0_type, & @@ -3602,6 +3604,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #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 @@ -3978,7 +3981,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & 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 + 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) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 140ac2169..25735d727 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1144,7 +1144,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) else Sfcprop(nb)%landfrac(ix) = 0.0 ! water if (Sfcprop(nb)%lakefrac(ix) > 0.0 .or. & - (Sfcprop(nb)%oro_uf(ix) > 250.0 .and. .not. Model%ignore_lake) ) then + (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 From 7440f6938ac8cb30fd78f98c1e2356f5d089962a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 19 Feb 2020 16:36:59 +0000 Subject: [PATCH 26/32] update gcycle --- ccpp/framework | 2 +- gfsphysics/physics/gcycle.F90 | 16 ++++++++++++---- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/ccpp/framework b/ccpp/framework index 7ab419eee..e77210986 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 7ab419eeebe133e706d9825d14c5bdc5d190e60d +Subproject commit e7721098639ee73c2a69ee0e8423e8905549e240 diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 75618400e..bb17d54a6 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,23 @@ 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) + 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) else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) + endif + if (abs(slifcs(len) - 1.0) > 0.1) then + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) @@ -233,6 +241,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 From d587ec1307fef17b50593ff9c38c2db9f6bc7065 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 24 Feb 2020 21:46:59 +0000 Subject: [PATCH 27/32] point atmos_cubed_sphere to NOAA-EMC repo and ccpp/physics to SMoorthi-EMC SM_Jan102020 branch --- .gitmodules | 2 +- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 55d8e0bcc..04f33a38b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere + url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index a56907a44..db3acfbec 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit a56907a44461c7151e0ba266e160c8f1a1685882 +Subproject commit db3acfbec2ca00d1795b72b7ebf0b1e308506ced diff --git a/ccpp/physics b/ccpp/physics index a8384f09d..08aa96dc1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a8384f09d50a2ed398922c7c9a16489c0147c926 +Subproject commit 08aa96dc1b98713cb241975c0631302db428dcc8 From 302acd7e0bd57587ad20fb9af8334422a2de40a6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Feb 2020 17:02:27 +0000 Subject: [PATCH 28/32] reverting definition of do_cnvgwd in GFS_typedefs.F90 --- gfsphysics/GFS_layer/GFS_typedefs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index cf545a1d1..ea56d63a4 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -3545,7 +3545,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%rbcr = rbcr Model%do_gwd = maxval(Model%cdmbgwd) > 0.0 - Model%do_cnvgwd = Model%cnvgwd .and. (maxval(Model%cdmbgwd(3:4)) == 0.0 .and. .not. Model%do_ugwp) + Model%do_cnvgwd = Model%cnvgwd .and. maxval(Model%cdmbgwd(3:4)) == 0.0 #ifdef CCPP Model%do_mynnedmf = do_mynnedmf Model%do_mynnsfclay = do_mynnsfclay From 635053cdde07f75b2829867316c7874608fa9c6e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Feb 2020 17:15:35 +0000 Subject: [PATCH 29/32] removed 3 lines from gcycle.F90, which I previously forgot to delete --- gfsphysics/physics/gcycle.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index bb17d54a6..c045d1efc 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -199,9 +199,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%tsfc(ix) = TSFFCS (len) Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif - if (abs(slifcs(len) - 1.0) > 0.1) then - Sfcprop(nb)%tsfco(ix) = TSFFCS (len) - endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) From bd8282e1d900b76c234e544e169894a1319217c8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Feb 2020 19:02:05 +0000 Subject: [PATCH 30/32] fixing a bug in gcycle update --- ccpp/physics | 2 +- gfsphysics/physics/gcycle.F90 | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 08aa96dc1..21190a8d0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 08aa96dc1b98713cb241975c0631302db428dcc8 +Subproject commit 21190a8d03d977b0569d39a34cb38d4cabee580e diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index c045d1efc..7c4861985 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -190,11 +190,13 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then - Sfcprop(nb)%tref(ix) = TSFFCS (len) - 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) + 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)%tsfco(ix) = TSFFCS (len) From e28c52f214c390aeafe1a5a380df71b5613e35b7 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 Feb 2020 11:49:40 +0000 Subject: [PATCH 31/32] removing updating tsfco in gcycle when nsstr is on --- ccpp/physics | 2 +- gfsphysics/physics/gcycle.F90 | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 21190a8d0..593666151 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 21190a8d03d977b0569d39a34cb38d4cabee580e +Subproject commit 5936661510b5f8b28a52f0ecbc14599e3c46964c diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 7c4861985..e3666c26a 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -191,12 +191,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then 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 +! 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)%tsfco(ix) = TSFFCS (len) From eb44dfe82b3bc7d60612e2cc013655706acad7ad Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 5 Mar 2020 14:56:54 +0000 Subject: [PATCH 32/32] updating .gitmodules to point to NCAR/ccpp-physics master branch --- .gitmodules | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 04f33a38b..d253f6966 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,5 +8,5 @@ branch = master [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jan102020 + url = https://github.com/NCAR/ccpp-physics + branch = master diff --git a/ccpp/physics b/ccpp/physics index 593666151..e7909b4f3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5936661510b5f8b28a52f0ecbc14599e3c46964c +Subproject commit e7909b4f34336742cab7d4ee687ae467f8fd646c