From a0fb86dec6bf53301fae020f55e3ca61d0fd4eb9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 17 Oct 2019 18:54:18 +0000 Subject: [PATCH 001/217] 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 002/217] 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 003/217] 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 004/217] 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 005/217] 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 006/217] 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 007/217] 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 008/217] 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 009/217] 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 010/217] 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 011/217] 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 012/217] 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 013/217] 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 014/217] 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 015/217] 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 016/217] 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 017/217] 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 018/217] 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 019/217] 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 020/217] 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 021/217] 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 022/217] 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 023/217] 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 024/217] 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 025/217] 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 026/217] 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 027/217] 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 028/217] 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 029/217] 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 030/217] 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 031/217] 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 fdf4c9b709c751d51ac3b12abdfcab69ea74fab4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 5 Mar 2020 15:05:21 +0000 Subject: [PATCH 032/217] updated gcycle and sfcsub on the ipd side --- ccpp/physics | 2 +- gfsphysics/physics/gcycle.F90 | 8 + gfsphysics/physics/sfcsub.F | 1831 +++++++++++++++++---------------- 3 files changed, 946 insertions(+), 895 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 593666151..f8eb82ca3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5936661510b5f8b28a52f0ecbc14599e3c46964c +Subproject commit f8eb82ca3da1e4dfd8665064998ff02279107002 diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index e3666c26a..b5cb28732 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -55,6 +55,8 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) STCFC1 (Model%nx*Model%ny*Model%lsoil), & SLCFC1 (Model%nx*Model%ny*Model%lsoil) + logical :: lake(Model%nx*Model%ny) + character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi real(kind=kind_phys) :: sig1t, dt_warm @@ -144,6 +146,11 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ELSE AISFCS(len) = 0. ENDIF + if (Sfcprop(nb)%lakefrac(ix) > 0.0) then + lake(len) = .true. + else + lake(len) = .false. + endif ! if (Model%me .eq. 0) ! & print *,' len=',len,' rla=',rla(len),' rlo=',rlo(len) @@ -178,6 +185,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) CVBFCS, CVTFCS, Model%me, Model%nlunit, & size(Model%input_nml_file), & Model%input_nml_file, & + lake, Model%min_lakeice, Model%min_seaice, & Model%ialb, Model%isot, Model%ivegsrc, & trim(tile_num_ch), i_index, j_index) #ifndef INTERNAL_FILE_NML diff --git a/gfsphysics/physics/sfcsub.F b/gfsphysics/physics/sfcsub.F index 4fbabab8f..f3291e892 100644 --- a/gfsphysics/physics/sfcsub.F +++ b/gfsphysics/physics/sfcsub.F @@ -28,103 +28,107 @@ module sfccyc_module integer :: soil_type_landice ! end module sfccyc_module - subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc - &, iy,im,id,ih,fh - &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl - &, sihfcs,sicfcs,sitfcs - &, swdfcs,slcfcs - &, vmnfcs,vmxfcs,slpfcs,absfcs - &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs - &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs - &, vegfcs,vetfcs,sotfcs,alffcs - &, cvfcs,cvbfcs,cvtfcs,me,nlunit - &, sz_nml,input_nml_file + subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & + &, iy,im,id,ih,fh & + &, rla, rlo, slmask,orog,orog_uf,use_ufo,nst_anl & + &, sihfcs,sicfcs,sitfcs & + &, swdfcs,slcfcs & + &, vmnfcs,vmxfcs,slpfcs,absfcs & + &, tsffcs,snofcs,zorfcs,albfcs,tg3fcs & + &, cnpfcs,smcfcs,stcfcs,slifcs,aisfcs & + &, vegfcs,vetfcs,sotfcs,alffcs & + &, cvfcs,cvbfcs,cvtfcs,me,nlunit & + &, sz_nml,input_nml_file & + &, lake, min_lakeice, min_seaice & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) ! use machine , only : kind_io8,kind_io4 use sfccyc_module implicit none - character(len=*), intent(in) :: tile_num_ch - integer,intent(in) :: i_index(len), j_index(len) - logical use_ufo, nst_anl - real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, - & orolmx,orolmn,oroomx,oroomn,orosmx, - & orosmn,oroimx,oroimn,orojmx,orojmn, - & alblmx,alblmn,albomx,albomn,albsmx, - & albsmn,albimx,albimn,albjmx,albjmn, - & wetlmx,wetlmn,wetomx,wetomn,wetsmx, - & wetsmn,wetimx,wetimn,wetjmx,wetjmn, - & snolmx,snolmn,snoomx,snoomn,snosmx, - & snosmn,snoimx,snoimn,snojmx,snojmn, - & zorlmx,zorlmn,zoromx,zoromn,zorsmx, - & zorsmn,zorimx,zorimn,zorjmx, zorjmn, - & plrlmx,plrlmn,plromx,plromn,plrsmx, - & plrsmn,plrimx,plrimn,plrjmx,plrjmn, - & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, - & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, - & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, - & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, - & stclmx,stclmn,stcomx,stcomn,stcsmx, - & stcsmn,stcimx,stcimn,stcjmx,stcjmn, - & smclmx,smclmn,smcomx,smcomn,smcsmx, - & smcsmn,smcimx,smcimn,smcjmx,smcjmn, - & scvlmx,scvlmn,scvomx,scvomn,scvsmx, - & scvsmn,scvimx,scvimn,scvjmx,scvjmn, - & veglmx,veglmn,vegomx,vegomn,vegsmx, - & vegsmn,vegimx,vegimn,vegjmx,vegjmn, - & vetlmx,vetlmn,vetomx,vetomn,vetsmx, - & vetsmn,vetimx,vetimn,vetjmx,vetjmn, - & sotlmx,sotlmn,sotomx,sotomn,sotsmx, - & sotsmn,sotimx,sotimn,sotjmx,sotjmn, - & alslmx,alslmn,alsomx,alsomn,alssmx, - & alssmn,alsimx,alsimn,alsjmx,alsjmn, - & epstsf,epsalb,epssno,epswet,epszor, - & epsplr,epsoro,epssmc,epsscv,eptsfc, - & epstg3,epsais,epsacn,epsveg,epsvet, - & epssot,epsalf,qctsfs,qcsnos,qctsfi, - & aislim,snwmin,snwmax,cplrl,cplrs, - & cvegl,czors,csnol,csnos,czorl,csots, - & csotl,cvwgs,cvetl,cvets,calfs, - & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, - & calbl,calfl,calbs,ctsfs,grboro, - & grbmsk,ctsfl,deltf,caisl,caiss, - & fsalfl,fsalfs,flalfs,falbl,ftsfl, - & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, - & faiss,fsnol,bltmsk,falbs,cvegs,percrit, - & deltsfc,critp2,critp3,blnmsk,critp1, - & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, - & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, - & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, - & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 - &, fsihl,fsihs,fsicl,fsics, - & csihl,csihs,csicl,csics,epssih,epssic - &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, - & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, - & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, - & epsslp,epsabs - &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, - & sihsmn,sihimx,sihimn,sihjmx,sihjmn, - & siclmx,siclmn,sicomx,sicomn,sicsmx, - & sicsmn,sicimx,sicimn,sicjmx,sicjmn - &, glacir_hice - &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, - & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, - & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, - & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, - & slplmx,slplmn,slpomx,slpomn,slpsmx, - & slpsmn,slpimx,slpimn,slpjmx,slpjmn, - & abslmx,abslmn,absomx,absomn,abssmx, - & abssmn,absimx,absimn,absjmx,absjmn + character(len=*), intent(in) :: tile_num_ch + integer, intent(in) :: i_index(len), j_index(len) + logical, intent(in) :: use_ufo, nst_anl + logical, intent(in) :: lake(len) + real (kind=kind_io8), intent(in) :: min_lakeice, min_seaice + + real (kind=kind_io8) sllnd,slsea,aicice,aicsea,tgice,rlapse, & + & orolmx,orolmn,oroomx,oroomn,orosmx, & + & orosmn,oroimx,oroimn,orojmx,orojmn, & + & alblmx,alblmn,albomx,albomn,albsmx, & + & albsmn,albimx,albimn,albjmx,albjmn, & + & wetlmx,wetlmn,wetomx,wetomn,wetsmx, & + & wetsmn,wetimx,wetimn,wetjmx,wetjmn, & + & snolmx,snolmn,snoomx,snoomn,snosmx, & + & snosmn,snoimx,snoimn,snojmx,snojmn, & + & zorlmx,zorlmn,zoromx,zoromn,zorsmx, & + & zorsmn,zorimx,zorimn,zorjmx,zorjmn, & + & plrlmx,plrlmn,plromx,plromn,plrsmx, & + & plrsmn,plrimx,plrimn,plrjmx,plrjmn, & + & tsflmx,tsflmn,tsfomx,tsfomn,tsfsmx, & + & tsfsmn,tsfimx,tsfimn,tsfjmx,tsfjmn, & + & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3smx, & + & tg3smn,tg3imx,tg3imn,tg3jmx,tg3jmn, & + & stclmx,stclmn,stcomx,stcomn,stcsmx, & + & stcsmn,stcimx,stcimn,stcjmx,stcjmn, & + & smclmx,smclmn,smcomx,smcomn,smcsmx, & + & smcsmn,smcimx,smcimn,smcjmx,smcjmn, & + & scvlmx,scvlmn,scvomx,scvomn,scvsmx, & + & scvsmn,scvimx,scvimn,scvjmx,scvjmn, & + & veglmx,veglmn,vegomx,vegomn,vegsmx, & + & vegsmn,vegimx,vegimn,vegjmx,vegjmn, & + & vetlmx,vetlmn,vetomx,vetomn,vetsmx, & + & vetsmn,vetimx,vetimn,vetjmx,vetjmn, & + & sotlmx,sotlmn,sotomx,sotomn,sotsmx, & + & sotsmn,sotimx,sotimn,sotjmx,sotjmn, & + & alslmx,alslmn,alsomx,alsomn,alssmx, & + & alssmn,alsimx,alsimn,alsjmx,alsjmn, & + & epstsf,epsalb,epssno,epswet,epszor, & + & epsplr,epsoro,epssmc,epsscv,eptsfc, & + & epstg3,epsais,epsacn,epsveg,epsvet, & + & epssot,epsalf,qctsfs,qcsnos,qctsfi, & + & aislim,snwmin,snwmax,cplrl,cplrs, & + & cvegl,czors,csnol,csnos,czorl,csots, & + & csotl,cvwgs,cvetl,cvets,calfs, & + & fcalfl,fcalfs,ccvt,ccnp,ccv,ccvb, & + & calbl,calfl,calbs,ctsfs,grboro, & + & grbmsk,ctsfl,deltf,caisl,caiss, & + & fsalfl,fsalfs,flalfs,falbl,ftsfl, & + & ftsfs,fzorl,fzors,fplrl,fsnos,faisl, & + & faiss,fsnol,bltmsk,falbs,cvegs,percrit, & + & deltsfc,critp2,critp3,blnmsk,critp1, & + & fcplrl,fcplrs,fczors,fvets,fsotl,fsots, & + & fvetl,fplrs,fvegl,fvegs,fcsnol,fcsnos, & + & fczorl,fcalbs,fctsfl,fctsfs,fcalbl, & + & falfs,falfl,fh,crit,zsca,ztsfc,tem1,tem2 & + &, fsihl,fsihs,fsicl,fsics, & + & csihl,csihs,csicl,csics,epssih,epssic & + &, fvmnl,fvmns,fvmxl,fvmxs,fslpl,fslps, & + & fabsl,fabss,cvmnl,cvmns,cvmxl,cvmxs, & + & cslpl,cslps,cabsl,cabss,epsvmn,epsvmx, & + & epsslp,epsabs & + &, sihlmx,sihlmn,sihomx,sihomn,sihsmx, & + & sihsmn,sihimx,sihimn,sihjmx,sihjmn, & + & siclmx,siclmn,sicomx,sicomn,sicsmx, & + & sicsmn,sicimx,sicimn,sicjmx,sicjmn & + &, glacir_hice & + &, vmnlmx,vmnlmn,vmnomx,vmnomn,vmnsmx, & + & vmnsmn,vmnimx,vmnimn,vmnjmx,vmnjmn, & + & vmxlmx,vmxlmn,vmxomx,vmxomn,vmxsmx, & + & vmxsmn,vmximx,vmximn,vmxjmx,vmxjmn, & + & slplmx,slplmn,slpomx,slpomn,slpsmx, & + & slpsmn,slpimx,slpimn,slpjmx,slpjmn, & + & abslmx,abslmn,absomx,absomn,abssmx, & + & abssmn,absimx,absimn,absjmx,absjmn & &, sihnew - integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, - & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, - & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, - & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, - & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, - & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb + integer imsk,jmsk,ifp,irtscv,irtacn,irtais,irtsno,irtzor, & + & irtalb,irtsot,irtalf,j,irtvet,irtsmc,irtstc,irtveg, & + & irtwet,k,iprnt,kk,irttsf,iret,i,igrdbg,iy,im,id, & + & icalbl,icalbs,icalfl,ictsfs,lugb,len,lsoil,ih, & + & ictsfl,iczors,icplrl,icplrs,iczorl,icalfs,icsnol, & + & icsnos,irttg3,me,kqcm,nlunit,sz_nml,ialb & &, irtvmn, irtvmx, irtslp, irtabs, isot, ivegsrc - logical gausm, deads, qcmsk, znlst, monclm, monanl, + logical gausm, deads, qcmsk, znlst, monclm, monanl, & & monfcs, monmer, mondif, landice character(len=*), intent(in) :: input_nml_file(sz_nml) @@ -265,8 +269,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! & sihsmx=8.0,sihsmn=0.0,sihimx=8.0,sihimn=0.10, ! & sihjmx=8.0,sihjmn=0.10,glacir_hice=3.0) parameter(siclmx=0.0,siclmn=0.0,sicomx=1.0,sicomn=0.0, - & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15, - & sicjmx=1.0,sicjmn=0.15) + & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicjmx=1.0) +! & sicsmx=1.0,sicsmn=0.0,sicimx=1.0,sicimn=0.15, +! & sicjmx=1.0,sicjmn=0.15) parameter(wetlmx=0.15,wetlmn=0.00,wetomx=0.15,wetomn=0.15, & wetsmx=0.15,wetsmn=0.15,wetimx=0.15,wetimn=0.15, @@ -415,7 +420,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! mask orography and variance on gaussian grid ! - real (kind=kind_io8) slmask(len),orog(len), orog_uf(len) + real (kind=kind_io8) slmask(len),orog(len), orog_uf(len) & &, orogd(len) real (kind=kind_io8) rla(len), rlo(len) ! @@ -428,50 +433,50 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! climatology surface fields (last character 'c' or 'clm' indicate climatology) ! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc, - & fnvegc,fnvetc,fnsotc - &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2 - real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len), - & zorclm(len), albclm(len,4), aisclm(len), - & tg3clm(len), acnclm(len), cnpclm(len), - & cvclm (len), cvbclm(len), cvtclm(len), - & scvclm(len), tsfcl2(len), vegclm(len), - & vetclm(len), sotclm(len), alfclm(len,2), sliclm(len), - & smcclm(len,lsoil), stcclm(len,lsoil) - &, sihclm(len), sicclm(len) + character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc & + &, fnplrc,fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc & + &, fnvegc,fnvetc,fnsotc & + &, fnvmnc,fnvmxc,fnslpc,fnabsc, fnalbc2 + real (kind=kind_io8) tsfclm(len), wetclm(len), snoclm(len) & + &, zorclm(len), albclm(len,4), aisclm(len) & + &, tg3clm(len), acnclm(len), cnpclm(len) & + &, cvclm (len), cvbclm(len), cvtclm(len) & + &, scvclm(len), tsfcl2(len), vegclm(len) & + &, vetclm(len), sotclm(len), alfclm(len,2), sliclm(len) & + &, smcclm(len,lsoil), stcclm(len,lsoil) & + &, sihclm(len), sicclm(len) & &, vmnclm(len), vmxclm(len), slpclm(len), absclm(len) ! ! analyzed surface fields (last character 'a' or 'anl' indicate analysis) ! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna, - & fnvega,fnveta,fnsota - &, fnvmna,fnvmxa,fnslpa,fnabsa -! - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), cnpanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & scvanl(len), tsfan2(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), slianl(len), - & smcanl(len,lsoil), stcanl(len,lsoil) - &, sihanl(len), sicanl(len) + character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa & + &, fnplra,fntg3a,fnscva,fnsmca,fnstca,fnacna & + &, fnvega,fnveta,fnsota & + &, fnvmna,fnvmxa,fnslpa,fnabsa +! + real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len) & + &, zoranl(len), albanl(len,4), aisanl(len) & + &, tg3anl(len), acnanl(len), cnpanl(len) & + &, cvanl (len), cvbanl(len), cvtanl(len) & + &, scvanl(len), tsfan2(len), veganl(len) & + &, vetanl(len), sotanl(len), alfanl(len,2), slianl(len) & + &, smcanl(len,lsoil), stcanl(len,lsoil) & + &, sihanl(len), sicanl(len) & &, vmnanl(len), vmxanl(len), slpanl(len), absanl(len) ! real (kind=kind_io8) tsfan0(len) ! sea surface temperature analysis at ft=0. ! ! predicted surface fields (last characters 'fcs' indicates forecast) ! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & tg3fcs(len), acnfcs(len), cnpfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2), - & smcfcs(len,lsoil), stcfcs(len,lsoil) - &, sihfcs(len), sicfcs(len), sitfcs(len) - &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) + real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len) & + &, zorfcs(len), albfcs(len,4), aisfcs(len) & + &, tg3fcs(len), acnfcs(len), cnpfcs(len) & + &, cvfcs (len), cvbfcs(len), cvtfcs(len) & + &, slifcs(len), vegfcs(len) & + &, vetfcs(len), sotfcs(len), alffcs(len,2) & + &, smcfcs(len,lsoil), stcfcs(len,lsoil) & + &, sihfcs(len), sicfcs(len), sitfcs(len) & + &, vmnfcs(len), vmxfcs(len), slpfcs(len), absfcs(len) & &, swdfcs(len), slcfcs(len,lsoil) ! ! ratio of sigma level 1 wind and 10m wind (diagnozed by model and not touched @@ -553,8 +558,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! lqcbgs=.true. quality controls input bges file before merging (should have been ! qced in the forecast program) ! - logical ldebug,lqcbgs - logical lprnt + logical :: ldebug,lqcbgs, lprnt ! ! debug only ! @@ -775,7 +779,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc abslmn = .01 abssmn = .01 endif - if(ifp.eq.0) then + if (ifp == 0) then ifp = 1 do k=1,lsoil fsmcl(k) = 99999. @@ -792,15 +796,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc #endif ! write(6,namsfc) ! - if (me .eq. 0) then - print *,'ftsfl,falbl,faisl,fsnol,fzorl=', - & ftsfl,falbl,faisl,fsnol,fzorl - print *,'fsmcl=',fsmcl(1:lsoil) - print *,'fstcl=',fstcl(1:lsoil) - print *,'ftsfs,falbs,faiss,fsnos,fzors=', - & ftsfs,falbs,faiss,fsnos,fzors - print *,'fsmcs=',fsmcs(1:lsoil) - print *,'fstcs=',fstcs(1:lsoil) + if (me == 0) then + print *,' ftsfl,falbl,faisl,fsnol,fzorl=', & + & ftsfl,falbl,faisl,fsnol,fzorl + print *,' fsmcl=',fsmcl(1:lsoil) + print *,' fstcl=',fstcl(1:lsoil) + print *,' ftsfs,falbs,faiss,fsnos,fzors=', & + & ftsfs,falbs,faiss,fsnos,fzors + print *,' fsmcs=',fsmcs(1:lsoil) + print *,' fstcs=',fstcs(1:lsoil) print *,' aislim=',aislim,' sihnew=',sihnew print *,' isot=', isot,' ivegsrc=',ivegsrc endif @@ -818,176 +822,176 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! deltf = deltsfc / 24.0 ! - ctsfl=0. !... tsfc over land - if(ftsfl.ge.99999.) ctsfl=1. - if((ftsfl.gt.0.).and.(ftsfl.lt.99999)) ctsfl=exp(-deltf/ftsfl) + ctsfl = 0. !... tsfc over land + if (ftsfl >= 99999.) ctsfl = 1. + if (ftsfl > 0. .and. ftsfl < 99999) ctsfl = exp(-deltf/ftsfl) ! ctsfs=0. !... tsfc over sea - if(ftsfs.ge.99999.) ctsfs=1. - if((ftsfs.gt.0.).and.(ftsfs.lt.99999)) ctsfs=exp(-deltf/ftsfs) + if (ftsfs >= 99999.) ctsfs=1. + if (ftsfs > 0. .and. ftsfs < 99999) ctsfs = exp(-deltf/ftsfs) ! do k=1,lsoil - csmcl(k)=0. !... soilm over land - if(fsmcl(k).ge.99999.) csmcl(k)=1. - if((fsmcl(k).gt.0.).and.(fsmcl(k).lt.99999)) - & csmcl(k)=exp(-deltf/fsmcl(k)) + csmcl(k) = 0. !... soilm over land + if (fsmcl(k) >= 99999.) csmcl(k) = 1. + if (fsmcl(k) > 0. .and. fsmcl(k) < 99999) + & csmcl(k) = exp(-deltf/fsmcl(k)) csmcs(k)=0. !... soilm over sea - if(fsmcs(k).ge.99999.) csmcs(k)=1. - if((fsmcs(k).gt.0.).and.(fsmcs(k).lt.99999)) - & csmcs(k)=exp(-deltf/fsmcs(k)) + if (fsmcs(k) >= 99999.) csmcs(k) = 1. + if (fsmcs(k) > 0. .and. fsmcs(k) < 99999) + & csmcs(k) = exp(-deltf/fsmcs(k)) enddo ! - calbl=0. !... albedo over land - if(falbl.ge.99999.) calbl=1. - if((falbl.gt.0.).and.(falbl.lt.99999)) calbl=exp(-deltf/falbl) + calbl = 0. !... albedo over land + if (falbl >= 99999.) calbl = 1. + if (falbl > 0. .and. falbl < 99999) calbl = exp(-deltf/falbl) ! calfl=0. !... fraction field for albedo over land - if(falfl.ge.99999.) calfl=1. - if((falfl.gt.0.).and.(falfl.lt.99999)) calfl=exp(-deltf/falfl) + if (falfl >= 99999.) calfl = 1. + if (falfl > 0. .and. falfl < 99999) calfl = exp(-deltf/falfl) ! calbs=0. !... albedo over sea - if(falbs.ge.99999.) calbs=1. - if((falbs.gt.0.).and.(falbs.lt.99999)) calbs=exp(-deltf/falbs) + if (falbs >= 99999.) calbs = 1. + if (falbs > 0. .and. falbs < 99999) calbs = exp(-deltf/falbs) ! - calfs=0. !... fraction field for albedo over sea - if(falfs.ge.99999.) calfs=1. - if((falfs.gt.0.).and.(falfs.lt.99999)) calfs=exp(-deltf/falfs) + calfs = 0. !... fraction field for albedo over sea + if (falfs >= 99999.) calfs = 1. + if (falfs > 0. .and. falfs < 99999) calfs = exp(-deltf/falfs) ! - caisl=0. !... sea ice over land - if(faisl.ge.99999.) caisl=1. - if((faisl.gt.0.).and.(faisl.lt.99999)) caisl=1. + caisl = 0. !... sea ice over land + if (faisl >= 99999.) caisl = 1. + if (faisl > 0. .and. faisl < 99999) caisl = 1. ! - caiss=0. !... sea ice over sea - if(faiss.ge.99999.) caiss=1. - if((faiss.gt.0.).and.(faiss.lt.99999)) caiss=1. + caiss = 0. !... sea ice over sea + if (faiss >= 99999.) caiss = 1. + if (faiss > 0. .and. faiss < 99999) caiss = 1. ! - csnol=0. !... snow over land - if(fsnol.ge.99999.) csnol=1. - if((fsnol.gt.0.).and.(fsnol.lt.99999)) csnol=exp(-deltf/fsnol) + csnol = 0. !... snow over land + if (fsnol >= 99999.) csnol = 1. + if (fsnol > 0. .and. fsnol < 99999) csnol = exp(-deltf/fsnol) ! using the same way to bending snow as narr when fsnol is the negative value ! the magnitude of fsnol is the thread to determine the lower and upper bound ! of final swe - if(fsnol.lt.0.)csnol=fsnol + if (fsnol < 0.) csnol = fsnol ! - csnos=0. !... snow over sea - if(fsnos.ge.99999.) csnos=1. - if((fsnos.gt.0.).and.(fsnos.lt.99999)) csnos=exp(-deltf/fsnos) + csnos = 0. !... snow over sea + if (fsnos >= 99999.) csnos = 1. + if (fsnos > 0 .and. fsnos < 99999) csnos = exp(-deltf/fsnos) ! - czorl=0. !... roughness length over land - if(fzorl.ge.99999.) czorl=1. - if((fzorl.gt.0.).and.(fzorl.lt.99999)) czorl=exp(-deltf/fzorl) + czorl = 0. !... roughness length over land + if (fzorl >= 99999.) czorl = 1. + if (fzorl > 0. .and. fzorl < 99999) czorl = exp(-deltf/fzorl) ! - czors=0. !... roughness length over sea - if(fzors.ge.99999.) czors=1. - if((fzors.gt.0.).and.(fzors.lt.99999)) czors=exp(-deltf/fzors) + czors = 0. !... roughness length over sea + if (fzors >= 99999.) czors = 1. + if (fzors > 0. .and. fzors < 99999) czors = exp(-deltf/fzors) ! -! cplrl=0. !... plant resistance over land -! if(fplrl.ge.99999.) cplrl=1. -! if((fplrl.gt.0.).and.(fplrl.lt.99999)) cplrl=exp(-deltf/fplrl) +! cplrl = 0. !... plant resistance over land +! if (fplrl >= 99999.) cplrl = 1. +! if (fplrl > 0. .and. fplrl < 99999) cplrl=exp(-deltf/fplrl) ! -! cplrs=0. !... plant resistance over sea -! if(fplrs.ge.99999.) cplrs=1. -! if((fplrs.gt.0.).and.(fplrs.lt.99999)) cplrs=exp(-deltf/fplrs) +! cplrs = 0. !... plant resistance over sea +! if (fplrs >= 99999.) cplrs = 1. +! if (fplrs > 0. .and. fplrs < 99999) cplrs=exp(-deltf/fplrs) ! do k=1,lsoil - cstcl(k)=0. !... soilt over land - if(fstcl(k).ge.99999.) cstcl(k)=1. - if((fstcl(k).gt.0.).and.(fstcl(k).lt.99999)) - & cstcl(k)=exp(-deltf/fstcl(k)) - cstcs(k)=0. !... soilt over sea - if(fstcs(k).ge.99999.) cstcs(k)=1. - if((fstcs(k).gt.0.).and.(fstcs(k).lt.99999)) - & cstcs(k)=exp(-deltf/fstcs(k)) + cstcl(k) = 0. !... soilt over land + if (fstcl(k) >= 99999.) cstcl(k) = 1. + if (fstcl(k) > 0. .and. fstcl(k) < 99999) & + & cstcl(k) = exp(-deltf/fstcl(k)) + cstcs(k) = 0. !... soilt over sea + if (fstcs(k) >= 99999.) cstcs(k) = 1. + if (fstcs(k) > 0. .and. fstcs(k) < 99999) & + & cstcs(k) = exp(-deltf/fstcs(k)) enddo ! - cvegl=0. !... vegetation fraction over land - if(fvegl.ge.99999.) cvegl=1. - if((fvegl.gt.0.).and.(fvegl.lt.99999)) cvegl=exp(-deltf/fvegl) + cvegl = 0. !... vegetation fraction over land + if (fvegl >= 99999.) cvegl = 1. + if (fvegl > 0. .and. fvegl < 99999) cvegl = exp(-deltf/fvegl) ! - cvegs=0. !... vegetation fraction over sea - if(fvegs.ge.99999.) cvegs=1. - if((fvegs.gt.0.).and.(fvegs.lt.99999)) cvegs=exp(-deltf/fvegs) + cvegs = 0. !... vegetation fraction over sea + if (fvegs >= 99999.) cvegs = 1. + if (fvegs > 0. .and. fvegs < 99999) cvegs = exp(-deltf/fvegs) ! - cvetl=0. !... vegetation type over land - if(fvetl.ge.99999.) cvetl=1. - if((fvetl.gt.0.).and.(fvetl.lt.99999)) cvetl=exp(-deltf/fvetl) + cvetl = 0. !... vegetation type over land + if (fvetl >= 99999.) cvetl = 1. + if (fvetl > 0. .and. fvetl < 99999) cvetl = exp(-deltf/fvetl) ! - cvets=0. !... vegetation type over sea - if(fvets.ge.99999.) cvets=1. - if((fvets.gt.0.).and.(fvets.lt.99999)) cvets=exp(-deltf/fvets) + cvets = 0. !... vegetation type over sea + if (fvets >= 99999.) cvets = 1. + if (fvets > 0. .and. fvets < 99999) cvets = exp(-deltf/fvets) ! - csotl=0. !... soil type over land - if(fsotl.ge.99999.) csotl=1. - if((fsotl.gt.0.).and.(fsotl.lt.99999)) csotl=exp(-deltf/fsotl) + csotl = 0. !... soil type over land + if (fsotl >= 99999.) csotl = 1. + if (fsotl > 0. .and. fsotl < 99999) csotl = exp(-deltf/fsotl) ! - csots=0. !... soil type over sea - if(fsots.ge.99999.) csots=1. - if((fsots.gt.0.).and.(fsots.lt.99999)) csots=exp(-deltf/fsots) + csots = 0. !... soil type over sea + if (fsots >= 99999.) csots = 1. + if (fsots > 0. .and. fsots < 99999) csots = exp(-deltf/fsots) !cwu [+16l]--------------------------------------------------------------- ! - csihl=0. !... sea ice thickness over land - if(fsihl.ge.99999.) csihl=1. - if((fsihl.gt.0.).and.(fsihl.lt.99999)) csihl=exp(-deltf/fsihl) + csihl = 0. !... sea ice thickness over land + if (fsihl >= 99999.) csihl = 1. + if (fsihl > 0. .and. fsihl < 99999) csihl = exp(-deltf/fsihl) ! - csihs=0. !... sea ice thickness over sea - if(fsihs.ge.99999.) csihs=1. - if((fsihs.gt.0.).and.(fsihs.lt.99999)) csihs=exp(-deltf/fsihs) + csihs = 0. !... sea ice thickness over sea + if (fsihs >= 99999.) csihs = 1. + if (fsihs > 0. .and. fsihs < 99999) csihs = exp(-deltf/fsihs) ! - csicl=0. !... sea ice concentration over land - if(fsicl.ge.99999.) csicl=1. - if((fsicl.gt.0.).and.(fsicl.lt.99999)) csicl=exp(-deltf/fsicl) + csicl = 0. !... sea ice concentration over land + if (fsicl >= 99999.) csicl = 1. + if (fsicl > 0. .and. fsicl < 99999) csicl = exp(-deltf/fsicl) ! - csics=0. !... sea ice concentration over sea - if(fsics.ge.99999.) csics=1. - if((fsics.gt.0.).and.(fsics.lt.99999)) csics=exp(-deltf/fsics) + csics = 0. !... sea ice concentration over sea + if (fsics >= 99999.) csics = 1. + if (fsics > 0. .and. fsics < 99999) csics = exp(-deltf/fsics) !clu [+32l]--------------------------------------------------------------- ! - cvmnl=0. !... min veg cover over land - if(fvmnl.ge.99999.) cvmnl=1. - if((fvmnl.gt.0.).and.(fvmnl.lt.99999)) cvmnl=exp(-deltf/fvmnl) + cvmnl = 0. !... min veg cover over land + if (fvmnl >= 99999.) cvmnl = 1. + if (fvmnl > 0. .and. fvmnl < 99999) cvmnl = exp(-deltf/fvmnl) ! - cvmns=0. !... min veg cover over sea - if(fvmns.ge.99999.) cvmns=1. - if((fvmns.gt.0.).and.(fvmns.lt.99999)) cvmns=exp(-deltf/fvmns) + cvmns = 0. !... min veg cover over sea + if (fvmns >= 99999.) cvmns = 1. + if (fvmns > 0. .and. fvmns < 99999) cvmns = exp(-deltf/fvmns) ! - cvmxl=0. !... max veg cover over land - if(fvmxl.ge.99999.) cvmxl=1. - if((fvmxl.gt.0.).and.(fvmxl.lt.99999)) cvmxl=exp(-deltf/fvmxl) + cvmxl = 0. !... max veg cover over land + if (fvmxl >= 99999.) cvmxl = 1. + if (fvmxl > 0. .and. fvmxl < 99999) cvmxl = exp(-deltf/fvmxl) ! - cvmxs=0. !... max veg cover over sea - if(fvmxs.ge.99999.) cvmxs=1. - if((fvmxs.gt.0.).and.(fvmxs.lt.99999)) cvmxs=exp(-deltf/fvmxs) + cvmxs = 0. !... max veg cover over sea + if (fvmxs >= 99999.) cvmxs = 1. + if (fvmxs > 0. .and. fvmxs < 99999) cvmxs = exp(-deltf/fvmxs) ! - cslpl=0. !... slope type over land - if(fslpl.ge.99999.) cslpl=1. - if((fslpl.gt.0.).and.(fslpl.lt.99999)) cslpl=exp(-deltf/fslpl) + cslpl = 0. !... slope type over land + if (fslpl >= 99999.) cslpl = 1. + if (fslpl > 0. .and. fslpl < 99999) cslpl = exp(-deltf/fslpl) ! - cslps=0. !... slope type over sea - if(fslps.ge.99999.) cslps=1. - if((fslps.gt.0.).and.(fslps.lt.99999)) cslps=exp(-deltf/fslps) + cslps = 0. !... slope type over sea + if (fslps >= 99999.) cslps = 1. + if (fslps > 0. .and. fslps < 99999) cslps = exp(-deltf/fslps) ! - cabsl=0. !... snow albedo over land - if(fabsl.ge.99999.) cabsl=1. - if((fabsl.gt.0.).and.(fabsl.lt.99999)) cabsl=exp(-deltf/fabsl) + cabsl = 0. !... snow albedo over land + if (fabsl >= 99999.) cabsl = 1. + if (fabsl > 0. .and. fabsl < 99999) cabsl = exp(-deltf/fabsl) ! - cabss=0. !... snow albedo over sea - if(fabss.ge.99999.) cabss=1. - if((fabss.gt.0.).and.(fabss.lt.99999)) cabss=exp(-deltf/fabss) + cabss = 0. !... snow albedo over sea + if (fabss >= 99999.) cabss = 1. + if (fabss > 0. .and. fabss < 99999) cabss = exp(-deltf/fabss) !clu ---------------------------------------------------------------------- ! -! read a high resolution mask field for use in grib interpolation +!> - Call hmskrd() to read a high resolution mask field for use in grib interpolation ! - call hmskrd(lugb,imsk,jmsk,fnmskh, + call hmskrd(lugb,imsk,jmsk,fnmskh, & & kpdmsk,slmskh,gausm,blnmsk,bltmsk,me) ! if (qcmsk) call qcmask(slmskh,sllnd,slsea,imsk,jmsk,rla,rlo) ! - if (me .eq. 0) then + if (me == 0) then write(6,*) ' ' write(6,*) ' lugb=',lugb,' len=',len, ' lsoil=',lsoil - write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh - &, ' sig1t(1)=',sig1t(1) + write(6,*) 'iy=',iy,' im=',im,' id=',id,' ih=',ih,' fh=',fh & + &, ' sig1t(1)=',sig1t(1) & &, ' gausm=',gausm,' blnmsk=',blnmsk,' bltmsk=',bltmsk write(6,*) ' ' endif @@ -1095,32 +1099,35 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc !* ice concentration or ice mask (only ice mask used in the model now) ! ice concentration and ice mask (both are used in the model now) ! - if(fnaisc(1:8).ne.' ') then + if(fnaisc(1:8) /= ' ') then !cwu [+5l/-1l] update sihclm, sicclm do i=1,len sihclm(i) = 3.0*aisclm(i) sicclm(i) = aisclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicclm(i) /= 1.0) then sicclm(i) = sicimx sihfcs(i) = glacir_hice endif enddo crit=aislim !* crit=0.5 - call rof01(aisclm,len,'ge',crit) - elseif(fnacnc(1:8).ne.' ') then +! call rof01(aisclm,len,'ge',crit) + call rof01_len(aisclm, len, 'ge', lake, min_lakeice, min_seaice) + + elseif(fnacnc(1:8) /= ' ') then !cwu [+4l] update sihclm, sicclm do i=1,len sihclm(i) = 3.0*acnclm(i) sicclm(i) = acnclm(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicclm(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicclm(i).ne.1.) then sicclm(i) = sicimx sihfcs(i) = glacir_hice endif enddo - call rof01(acnclm,len,'ge',aislim) +! call rof01(acnclm,len,'ge',aislim) + call rof01_len(acnclm, len, 'ge', lake, min_lakeice, min_seaice) do i=1,len aisclm(i) = acnclm(i) enddo @@ -1175,7 +1182,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! quality control ! do i=1,len - icefl2(i) = sicclm(i) .gt. 0.99999 + icefl2(i) = sicclm(i) > 0.99999 enddo kqcm=1 call qcmxmn('tsfc ',tsfclm,sliclm,snoclm,icefl2, @@ -1227,17 +1234,17 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('smc3c ',smcclm(1,3),sliclm,snoclm,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4c ',smcclm(1,4),sliclm,snoclm,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif - if(fnstcc(1:8).eq.' ') then + if(fnstcc(1:8) == ' ') then call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif call qcmxmn('stc1c ',stcclm(1,1),sliclm,snoclm,icefl1, @@ -1249,15 +1256,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcclm(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3c ',stcclm(1,3),sliclm,snoclm,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4c ',stcclm(1,4),sliclm,snoclm,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -1276,10 +1283,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicc ',sicclm,sliclm,snoclm,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, @@ -1302,7 +1309,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! monitoring prints ! if (monclm) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of time and space interpolated climatology' print *,' ' @@ -1352,7 +1359,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc endif ! ! - if (me .eq. 0) then + if (me == 0) then write(6,*) '==============' write(6,*) ' analysis' write(6,*) '==============' @@ -1451,42 +1458,48 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! ice concentration or ice mask (only ice mask used in the model now) ! - if(fnaisa(1:8).ne.' ') then + if(fnaisa(1:8) /= ' ') then !cwu [+5l/-1l] update sihanl, sicanl do i=1,len sihanl(i) = 3.0*aisanl(i) sicanl(i) = aisanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicanl(i) /= 1.) then sicanl(i) = sicimx sihfcs(i) = glacir_hice endif enddo - crit=aislim +! crit=aislim !* crit=0.5 - call rof01(aisanl,len,'ge',crit) - elseif(fnacna(1:8).ne.' ') then +! call rof01(aisanl,len,'ge',crit) + call rof01_len(aisanl, len, 'ge', lake, min_lakeice, min_seaice) + elseif(fnacna(1:8) /= ' ') then !cwu [+17l] update sihanl, sicanl do i=1,len sihanl(i) = 3.0*acnanl(i) sicanl(i) = acnanl(i) - if(slmask(i).eq.0..and.glacir(i).eq.1..and. - & sicanl(i).ne.1.) then + if(nint(slmask(i)) == 0 .and. nint(glacir(i)) == 1 & + & .and. sicanl(i) /= 1.) then sicanl(i) = sicimx sihfcs(i) = glacir_hice endif enddo - crit=aislim +! crit=aislim do i=1,len - if((slianl(i).eq.0.).and.(sicanl(i).ge.crit)) then - slianl(i)=2. + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (nint(slianl(i)) == 0 .and. sicanl(i) >= crit) then + slianl(i) = 2. ! print *,'cycle - new ice form: fice=',sicanl(i) - else if((slianl(i).ge.2.).and.(sicanl(i).lt.crit)) then - slianl(i)=0. + elseif (nint(slianl(i)) >= 2 .and. sicanl(i) < crit) then + slianl(i) = 0. ! print *,'cycle - ice free: fice=',sicanl(i) - else if((slianl(i).eq.1.).and.(sicanl(i).ge.sicimn)) then + elseif (nint(slianl(i)) == 1 .and. sicanl(i) > crit) then ! print *,'cycle - land covered by sea-ice: fice=',sicanl(i) - sicanl(i)=0. + sicanl(i) = 0. endif enddo ! znnt=10. @@ -1497,11 +1510,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! & .and. aisfcs(i) .ge. 0.75) acnanl(i) = aislim ! enddo ! if(lprnt) print *,' acnanl=',acnanl(iprnt) - call rof01(acnanl,len,'ge',aislim) +! call rof01(acnanl,len,'ge',aislim) + call rof01_len(acnanl, len, 'ge', lake, min_lakeice, min_seaice) do i=1,len - aisanl(i)=acnanl(i) + aisanl(i) = acnanl(i) enddo endif + ! if(lprnt) print *,' aisanl1=',aisanl(iprnt),' glacir=' ! &,glacir(iprnt),' slmask=',slmask(iprnt) ! @@ -1532,10 +1547,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sica ',sicanl,slianl,snoanl,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) ! ! set albedo over ocean to albomx ! @@ -1544,13 +1559,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! quality control of snow and sea-ice ! process snow depth or snow cover ! - if(fnsnoa(1:8).ne.' ') then + if (fnsnoa(1:8) /= ' ') then call setzro(snoanl,epssno,len) call qcsnow(snoanl,slmask,aisanl,glacir,len,ten,landice,me) if (.not.landice) then call snodpth2(glacir,snosmx,snoanl, len, me) endif - kqcm=1 + kqcm = 1 call snosfc(snoanl,tsfanl,tsfsmx,len,me) call qcmxmn('snoa ',snoanl,slianl,snoanl,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, @@ -1562,7 +1577,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & scvjmx,scvjmn,scvsmx,scvsmn,epsscv, & rla,rlo,len,kqcm,percrit,lgchek,me) else - crit=0.5 + crit = 0.5 call rof01(scvanl,len,'ge',crit) call qcsnow(scvanl,slmask,aisanl,glacir,len,one,landice,me) call qcmxmn('sncva ',scvanl,slianl,scvanl,icefl1, @@ -1580,7 +1595,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc endif ! do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 + icefl2(i) = sicanl(i) > 0.99999 enddo call qcmxmn('tsfa ',tsfanl,slianl,snoanl,icefl2, & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, @@ -1592,7 +1607,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) then + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ' ) then call qcmxmn('weta ',wetanl,slianl,snoanl,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, & wetjmx,wetjmn,wetsmx,wetsmn,epswet, @@ -1615,7 +1630,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! get soil temp and moisture ! - if(fnsmca(1:8).eq.' ' .and. fnsmcc(1:8).eq.' ') then + if(fnsmca(1:8) == ' ' .and. fnsmcc(1:8) == ' ') then call getsmc(wetanl,len,lsoil,smcanl,me) endif call qcmxmn('smc1a ',smcanl(1,1),slianl,snoanl,icefl1, @@ -1627,17 +1642,17 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('smc3a ',smcanl(1,3),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4a ',smcanl(1,4),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif - if(fnstca(1:8).eq.' ') then + if(fnstca(1:8) == ' ') then call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif call qcmxmn('stc1a ',stcanl(1,1),slianl,snoanl,icefl1, @@ -1649,15 +1664,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3a ',stcanl(1,3),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4a ',stcanl(1,4),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -1693,7 +1708,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! monitoring prints ! if (monanl) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of time and space interpolated analysis' print *,' ' @@ -1742,20 +1757,20 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! read in forecast fields if needed ! - if (me .eq. 0) then + if (me == 0) then write(6,*) '==============' write(6,*) ' fcst guess' write(6,*) '==============' endif ! - percrit=critp2 + percrit = critp2 ! if(deads) then ! ! fill in guess array with analysis if dead start. ! - percrit=critp3 - if (me .eq. 0) write(6,*) 'this run is dead start run' + percrit = critp3 + if (me == 0) write(6,*) 'this run is dead start run' call filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & tg3fcs,cvfcs ,cvbfcs,cvtfcs, & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, @@ -1773,13 +1788,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc !clu [+1l] add ()anl for vmn, vmx, slp, abs & vmnanl,vmxanl,slpanl,absanl, & len,lsoil) - if(sig1t(1).ne.0.) then + if (sig1t(1) /= 0.) then call usesgt(sig1t,slianl,tg3anl,len,lsoil,tsffcs,stcfcs, & tsfimx) do i=1,len - icefl2(i) = sicfcs(i) .gt. 0.99999 + icefl2(i) = sicfcs(i) > 0.99999 enddo - kqcm=1 + kqcm = 1 call qcmxmn('tsff ',tsffcs,slifcs,snofcs,icefl2, & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, @@ -1794,7 +1809,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & rla,rlo,len,kqcm,percrit,lgchek,me) endif else - percrit=critp2 + percrit = critp2 ! ! make reverse angulation correction to tsf ! make reverse orography correction to tg3 @@ -1823,7 +1838,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! do j=1, lsoil do i=1, len - if(smcfcs(i,j) .ne. 0.) then + if(smcfcs(i,j) /= 0.) then swratio(i,j) = slcfcs(i,j)/smcfcs(i,j) else swratio(i,j) = -999. @@ -1832,13 +1847,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc enddo !clu ----------------------------------------------------------------------- ! - if(lqcbgs .and. irtacn .eq. 0) then + if (lqcbgs .and. irtacn == 0) then call qcsli(slianl,slifcs,len,me) call albocn(albfcs,slmask,albomx,len) do i=1,len icefl2(i) = sicfcs(i) .gt. 0.99999 enddo - kqcm=1 + kqcm = 1 call qcmxmn('snof ',snofcs,slifcs,snofcs,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, & snojmx,snojmn,snosmx,snosmn,epssno, @@ -1853,7 +1868,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ' ) & then call qcmxmn('wetf ',wetfcs,slifcs,snofcs,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, @@ -1879,10 +1894,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicf ',sicfcs,slifcs,snofcs,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) call qcmxmn('smc1f ',smcfcs(1,1),slifcs,snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1892,15 +1907,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add smcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('smc3f ',smcfcs(1,3),slifcs,snofcs,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4f ',smcfcs(1,4),slifcs,snofcs,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, @@ -1911,15 +1926,15 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+8l] add stcfcs(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) + if (lsoil > 2) then + call qcmxmn('stc3f ',stcfcs(1,3),slifcs,snofcs,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4f ',stcfcs(1,4),slifcs,snofcs,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, @@ -1956,7 +1971,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc endif ! if (monfcs) then - if (me .eq. 0) then + if (me == 0) then print *,' ' print *,'monitor of guess' print *,' ' @@ -1971,11 +1986,11 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc call monitr('stcfcs1',stcfcs(1,1),slifcs,snofcs,len) call monitr('stcfcs2',stcfcs(1,2),slifcs,snofcs,len) !clu [+4l] add smcfcs(3:4) and stcfcs(3:4) - if(lsoil.gt.2) then - call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len) - call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len) - call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len) - call monitr('stcfcs4',stcfcs(1,4),slifcs,snofcs,len) + if (lsoil > 2) then + call monitr('smcfcs3',smcfcs(1,3),slifcs,snofcs,len) + call monitr('smcfcs4',smcfcs(1,4),slifcs,snofcs,len) + call monitr('stcfcs3',stcfcs(1,3),slifcs,snofcs,len) + call monitr('stcfcs4',stcfcs(1,4),slifcs,snofcs,len) endif call monitr('tg3fcs',tg3fcs,slifcs,snofcs,len) call monitr('zorfcs',zorfcs,slifcs,snofcs,len) @@ -2023,14 +2038,14 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! blend climatology and predicted fields ! - if(me .eq. 0) then + if(me == 0) then write(6,*) '==============' write(6,*) ' merging' write(6,*) '==============' endif ! if(lprnt) print *,' tsffcs=',tsffcs(iprnt) ! - percrit=critp3 + percrit = critp3 ! ! merge analysis and forecast. note tg3, ais are not merged ! @@ -2084,9 +2099,9 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc call snosfc(snoanl,tsfanl,tsfsmx,len,me) ! do i=1,len - icefl2(i) = sicanl(i) .gt. 0.99999 + icefl2(i) = sicanl(i) > 0.99999 enddo - kqcm=0 + kqcm = 0 call qcmxmn('snowm ',snoanl,slianl,snoanl,icefl1, & snolmx,snolmn,snoomx,snoomn,snoimx,snoimn, & snojmx,snojmn,snosmx,snosmn,epssno, @@ -2101,8 +2116,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & albjmx,albjmn,albsmx,albsmn,epsalb, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - if(fnwetc(1:8).ne.' ' .or. fnweta(1:8).ne.' ' ) - & then + if(fnwetc(1:8) /= ' ' .or. fnweta(1:8) /= ' ' ) then call qcmxmn('wetm ',wetanl,slianl,snoanl,icefl1, & wetlmx,wetlmn,wetomx,wetomn,wetimx,wetimn, & wetjmx,wetjmn,wetsmx,wetsmn,epswet, @@ -2127,17 +2141,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add stcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, - & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, - & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - endif call qcmxmn('smc1m ',smcanl(1,1),slianl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -2146,18 +2149,26 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) -!clu [+8l] add smcanl(3:4) - if(lsoil.gt.2) then - call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, - & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, - & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, - & rla,rlo,len,kqcm,percrit,lgchek,me) +!clu [+8l] add stcanl(3:4) + if (lsoil > 2) then + call qcmxmn('stc3m ',stcanl(1,3),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('stc4m ',stcanl(1,4),slianl,snoanl,icefl1, + & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, + & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc3m ',smcanl(1,3),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) + call qcmxmn('smc4m ',smcanl(1,4),slianl,snoanl,icefl1, + & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, + & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, + & rla,rlo,len,kqcm,percrit,lgchek,me) endif - kqcm=1 + kqcm = 1 call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, @@ -2175,10 +2186,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & sihlmx,sihlmn,sihomx,sihomn,sihimx,sihimn, & sihjmx,sihjmn,sihsmx,sihsmn,epssih, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1, - & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, - & sicjmx,sicjmn,sicsmx,sicsmn,epssic, - & rla,rlo,len,kqcm,percrit,lgchek,me) +! call qcmxmn('sicm ',sicanl,slianl,snoanl,icefl1, +! & siclmx,siclmn,sicomx,sicomn,sicimx,sicimn, +! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, +! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] add vmn, vmx, slp, abs call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, @@ -2198,7 +2209,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & rla,rlo,len,kqcm,percrit,lgchek,me) ! - if(me .eq. 0) then + if(me == 0) then write(6,*) '==============' write(6,*) 'final results' write(6,*) '==============' @@ -2228,7 +2239,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! check the final merged product ! if (monmer) then - if(me .eq. 0) then + if(me == 0) then print *,' ' print *,'monitor of updated surface fields' print *,' (includes angulation correction)' @@ -2244,13 +2255,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc call monitr('stcanl1',stcanl(1,1),slianl,snoanl,len) call monitr('stcanl2',stcanl(1,2),slianl,snoanl,len) !clu [+4l] add smcanl(3:4) and stcanl(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) - call monitr('tg3anl',tg3anl,slianl,snoanl,len) - call monitr('zoranl',zoranl,slianl,snoanl,len) + if (lsoil > 2) then + call monitr('smcanl3',smcanl(1,3),slianl,snoanl,len) + call monitr('smcanl4',smcanl(1,4),slianl,snoanl,len) + call monitr('stcanl3',stcanl(1,3),slianl,snoanl,len) + call monitr('stcanl4',stcanl(1,4),slianl,snoanl,len) + call monitr('tg3anl',tg3anl,slianl,snoanl,len) + call monitr('zoranl',zoranl,slianl,snoanl,len) endif ! if (gaus) then call monitr('cvaanl',cvanl ,slianl,snoanl,len) @@ -2312,7 +2323,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! monitoring prints ! - if(me .eq. 0) then + if(me == 0) then print *,' ' print *,'monitor of difference' print *,' (includes angulation correction)' @@ -2330,11 +2341,11 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc call monitr('stcanl1',stcfcs(1,1),slianl,snoanl,len) call monitr('stcanl2',stcfcs(1,2),slianl,snoanl,len) !clu [+4l] add smcfcs(3:4) and stc(3:4) - if(lsoil.gt.2) then - call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) - call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) - call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) - call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) + if (lsoil > 2) then + call monitr('smcanl3',smcfcs(1,3),slianl,snoanl,len) + call monitr('smcanl4',smcfcs(1,4),slianl,snoanl,len) + call monitr('stcanl3',stcfcs(1,3),slianl,snoanl,len) + call monitr('stcanl4',stcfcs(1,4),slianl,snoanl,len) endif call monitr('tg3dif',tg3fcs,slianl,snoanl,len) call monitr('zordif',zorfcs,slianl,snoanl,len) @@ -2405,15 +2416,21 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc enddo !cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points - crit=aislim +! crit=aislim do i=1,len sihfcs(i) = sihanl(i) sitfcs(i) = tsffcs(i) - if (slifcs(i).ge.2.) then - if (sicfcs(i).gt.crit) then + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (slifcs(i) >= 2.) then + if (sicfcs(i) > crit) then + tem1 = 1.0 / sicfcs(i) tsffcs(i) = (sicanl(i)*tsffcs(i) - & + (sicfcs(i)-sicanl(i))*tgice)/sicfcs(i) - sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) / sicfcs(i) + & + (sicfcs(i)-sicanl(i))*tgice) * tem1 + sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem1 else tsffcs(i) = tsfanl(i) ! tsffcs(i) = tgice @@ -2423,13 +2440,20 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc sicfcs(i) = sicanl(i) enddo do i=1,len - if (slifcs(i).lt.1.5) then + if (slifcs(i) < 1.5) then sihfcs(i) = 0. sicfcs(i) = 0. sitfcs(i) = tsffcs(i) - else if ((slifcs(i).ge.1.5).and.(sicfcs(i).lt.crit)) then - print *,'warning: check, slifcs and sicfcs', - & slifcs(i),sicfcs(i) + else + if (lake(i)) then + crit = min_lakeice + else + crit = min_seaice + endif + if (sicfcs(i) < crit) then + print *,'warning: check, slifcs and sicfcs', & + & slifcs(i),sicfcs(i) + endif endif enddo @@ -2438,29 +2462,29 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! do k=1, lsoil fixratio(k) = .false. - if (fsmcl(k).lt.99999.) fixratio(k) = .true. + if (fsmcl(k) < 99999.) fixratio(k) = .true. enddo - if(me .eq. 0) then - print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil) + if(me == 0) then + print *,'dbgx --fixratio:',(fixratio(k),k=1,lsoil) endif do k=1, lsoil if(fixratio(k)) then do i = 1, len - if(swratio(i,k) .eq. -999.) then + if(swratio(i,k) == -999.) then slcfcs(i,k) = smcfcs(i,k) else slcfcs(i,k) = swratio(i,k) * smcfcs(i,k) endif - if (slifcs(i) .ne. 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points. + if (slifcs(i) /= 1.0) slcfcs(i,k) = 1.0 ! flag value for non-land points. enddo endif enddo ! set liquid soil moisture to a flag value of 1.0 if (landice) then do i = 1, len - if (slifcs(i) .eq. 1.0 .and. + if (slifcs(i) == 1.0 .and. & nint(vetfcs(i)) == veg_type_landice) then do k=1, lsoil slcfcs(i,k) = 1.0 @@ -2471,13 +2495,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! ! ensure the consistency between snwdph and sheleg ! - if(fsnol .lt. 99999.) then - if(me .eq. 0) then - print *,'dbgx -- scale snwdph from sheleg' - endif - do i = 1, len - if(slifcs(i).eq.1.) swdfcs(i) = 10.* snofcs(i) - enddo + if(fsnol < 99999.) then + if(me == 0) then + print *,'dbgx -- scale snwdph from sheleg' + endif + do i = 1, len + if(slifcs(i) == 1.) swdfcs(i) = 10.* snofcs(i) + enddo endif ! sea ice model only uses the liquid equivalent depth. @@ -2485,14 +2509,14 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! use the same 3:1 ratio used by ice model. do i = 1, len - if (slifcs(i).ne.1) swdfcs(i) = 3.*snofcs(i) + if (slifcs(i) /= 1) swdfcs(i) = 3.*snofcs(i) enddo do i = 1, len - if(slifcs(i).eq.1.) then - if(snofcs(i).ne.0. .and. swdfcs(i).eq.0.) then - print *,'dbgx --scale snwdph from sheleg', - + i, swdfcs(i), snofcs(i) + if(slifcs(i) == 1.) then + if(snofcs(i) /= 0. .and. swdfcs(i) == 0.) then + print *,'dbgx --scale snwdph from sheleg', & + & i, swdfcs(i), snofcs(i) swdfcs(i) = 10.* snofcs(i) endif endif @@ -2504,7 +2528,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc ! after adjustment to terrain. if (landice) then do i = 1, len - if (slifcs(i) .eq. 1.0 .and. + if (slifcs(i) == 1.0 .and. & & nint(vetfcs(i)) == veg_type_landice) then snofcs(i) = max(snofcs(i),100.0) ! in mm swdfcs(i) = max(swdfcs(i),1000.0) ! in mm @@ -2648,7 +2672,7 @@ subroutine dayoyr(iyr,imo,idy,ldy) enddo return end - subroutine hmskrd(lugb,imsk,jmsk,fnmskh, + subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & & kpds5,slmskh,gausm,blnmsk,bltmsk,me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata, xdata, ydata @@ -2681,7 +2705,7 @@ subroutine hmskrd(lugb,imsk,jmsk,fnmskh, ! return end - subroutine fixrdg(lugb,idim,jdim,fngrib, + subroutine fixrdg(lugb,idim,jdim,fngrib, & & kpds5,gdata,gaus,blno,blto,me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata @@ -2796,8 +2820,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, deallocate(lbms) return end - subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr - &, me) + subroutine getarea(kgds,dlat,dlon,rslat,rnlat,wlon,elon,ijordr,me) use machine , only : kind_io8,kind_io4 implicit none integer j,me,kgds11 @@ -3006,16 +3029,16 @@ subroutine subst(data,imax,jmax,dlon,dlat,ijordr) endif return end - subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp, - & gauout,len,lmask,rslmsk,slmask + subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& + & gauout,len,lmask,rslmsk,slmask & &, outlat, outlon,me) use machine , only : kind_io8,kind_io4 implicit none - real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, - & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, - & wi1j2,wi2j1,rlat,rlon,aphi, + real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, & + & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, & + & wi1j2,wi2j1,rlat,rlon,aphi, & & rnume,alamd,denom - integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2, + integer jy,ifills,ix,len,inttyp,me,i,j,jmxin,imxin,jq,jx,j1,j2, & & ii,i1,i2,kmami,it integer nx,kxs,kxt integer, allocatable, save :: imxnx(:) @@ -3023,7 +3046,7 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp, ! ! interpolation from lat/lon or gaussian grid to other lat/lon grid ! - real (kind=kind_io8) outlon(len),outlat(len),gauout(len), + real (kind=kind_io8) outlon(len),outlat(len),gauout(len), & & slmask(len) real (kind=kind_io8) regin (imxin,jmxin),rslmsk(imxin,jmxin) ! @@ -3575,54 +3598,46 @@ subroutine maxmin(f,imax,kmax) ! return end - subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, - & aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, - & vetanl,sotanl,alfanl, -!cwu [+1l] add ()anl for sih, sic - & sihanl,sicanl, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm, - & aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, - & vetclm,sotclm,alfclm, -!cwu [+1l] add ()clm for sih, sic - & sihclm,sicclm, -!clu [+1l] add ()clm for vmn, vmx, slp, abs - & vmnclm,vmxclm,slpclm,absclm, + subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, & + & aisanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,scvanl,veganl, & + & vetanl,sotanl,alfanl, & + & sihanl,sicanl, & !cwu [+1l] add ()anl for sih, sic + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs + & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm, & + & aisclm, & + & tg3clm,cvclm ,cvbclm,cvtclm, & + & cnpclm,smcclm,stcclm,sliclm,scvclm,vegclm, & + & vetclm,sotclm,alfclm, & + & sihclm,sicclm, & !cwu [+1l] add ()clm for sih, sic + & vmnclm,vmxclm,slpclm,absclm, & !clu [+1l] add ()clm for vmn, vmx, slp, abs & len,lsoil) use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil ! - real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len), - & snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),scvanl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs + real (kind=kind_io8) tsfanl(len),tsfan2(len),wetanl(len), & + & snoanl(len), & + & zoranl(len),albanl(len,4),aisanl(len), & + & tg3anl(len), & + & cvanl (len),cvbanl(len),cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len),scvanl(len),veganl(len), & + & vetanl(len),sotanl(len),alfanl(len,2) & + &, sihanl(len),sicanl(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) - real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len), - & snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) -!cwu [+1l] add ()clm for sih, sic - &, sihclm(len),sicclm(len) -!clu [+1l] add ()clm for vmn, vmx, slp, abs + real (kind=kind_io8) tsfclm(len),tsfcl2(len),wetclm(len), & + & snoclm(len), & + & zorclm(len),albclm(len,4),aisclm(len), & + & tg3clm(len), & + & cvclm (len),cvbclm(len),cvtclm(len), & + & cnpclm(len), & + & smcclm(len,lsoil),stcclm(len,lsoil), & + & sliclm(len),scvclm(len),vegclm(len), & + & vetclm(len),sotclm(len),alfclm(len,2) & + &, sihclm(len),sicclm(len) & &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) ! do i=1,len @@ -3672,43 +3687,34 @@ subroutine filanl(tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl, ! return end - subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, - & fnveta,fnsota, -!clu [+1l] add fn()a for vmn, vmx, slp, abs - & fnvmna,fnvmxa,fnslpa,fnabsa, - & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & smcanl,stcanl,slianl,scvanl,acnanl,veganl, - & vetanl,sotanl,alfanl,tsfan0, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, -!cggg snow mods start & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais, -!cggg snow mods end - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kprvet,kpdsot,kpdalf, -!clu [+1l] add kpd() for vmn, vmx, slp, abs - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvet,irtsot,irtalf -!clu [+1l] add irt() for vmn, vmx, slp, abs - &, irtvmn,irtvmx,irtslp,irtabs - &, imsk, jmsk, slmskh, outlat, outlon + subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, & + & slmask,fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa,& + & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, & + & fnveta,fnsota, & + & fnvmna,fnvmxa,fnslpa,fnabsa, & !clu [+1l] add fn()a for vmn, vmx, slp, abs + & tsfanl,wetanl,snoanl,zoranl,albanl,aisanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & smcanl,stcanl,slianl,scvanl,acnanl,veganl, & + & vetanl,sotanl,alfanl,tsfan0, & + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs + & kpdtsf,kpdwet,kpdsno,kpdsnd,kpdzor,kpdalb,kpdais,& + & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, & + & kprvet,kpdsot,kpdalf, & + & kpdvmn,kpdvmx,kpdslp,kpdabs, & !clu [+1l] add kpd() for vmn, vmx, slp, abs + & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & !cggg snow mods + & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, & + & irtvet,irtsot,irtalf & + &, irtvmn,irtvmx,irtslp,irtabs & !clu [+1l] add irt() for vmn, vmx, slp, abs + &, imsk, jmsk, slmskh, outlat, outlon & &, gaus, blno, blto, me, lanom) use machine , only : kind_io8,kind_io4 implicit none logical lanom - integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno, - & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot, -!cggg snow mods start & imsk,jmsk,irtwet,lsoil,len, kpdtsf,kpdsno,kpdwet,iy, - & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy, -!cggg snow mods end - & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc, - & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j -!clu [+1l] add kpd() and irt() for vmn, vmx, slp, abs + integer irtsmc,irtacn,irtstc,irtvet,irtveg,irtscv,irtzor,irtsno, & + & irtalb,irttg3,irtais,iret,me,kk,kpdvet,i,irtalf,irtsot, & + & imsk,jmsk,irtwet,lsoil,len,kpdtsf,kpdsno,kpdsnd,kpdwet,iy,& + & lugb,im,ih,id,kpdveg,kpdstc,kprvet,irttsf,kpdsot,kpdsmc, & + & kpdais,kpdzor,kpdtg3,kpdacn,kpdscv,j & &, kpdvmn,kpdvmx,kpdslp,kpdabs,irtvmn,irtvmx,irtslp,irtabs real (kind=kind_io8) blto,blno,fh ! @@ -3721,21 +3727,19 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, integer lugi, lskip, lgrib, ndata !cggg snow mods end ! - character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, - & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, + character*500 fntsfa,fnweta,fnsnoa,fnzora,fnalba,fnaisa, & + & fntg3a,fnscva,fnsmca,fnstca,fnacna,fnvega, & & fnveta,fnsota -!clu [+1l] add fn()a for vmn, vmx, slp, abs &, fnvmna,fnvmxa,fnslpa,fnabsa - real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & tg3anl(len), acnanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & slianl(len), scvanl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2), - & smcanl(len,lsoil), stcanl(len,lsoil), - & tsfan0(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs + real (kind=kind_io8) tsfanl(len), wetanl(len), snoanl(len), & + & zoranl(len), albanl(len,4), aisanl(len), & + & tg3anl(len), acnanl(len), & + & cvanl (len), cvbanl(len), cvtanl(len), & + & slianl(len), scvanl(len), veganl(len), & + & vetanl(len), sotanl(len), alfanl(len,2), & + & smcanl(len,lsoil), stcanl(len,lsoil), & + & tsfan0(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! logical gaus @@ -3788,36 +3792,36 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, endif else do i=1,len - tsfan0(i)=-999.9 + tsfan0(i) = -999.9 enddo endif ! ! albedo ! - irtalb=0 + irtalb = 0 if(fnalba(1:8).ne.' ') then do kk = 1, 4 call fixrda(lugb,fnalba,kpdalb(kk),slmask, & iy,im,id,ih,fh,albanl(1,kk),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - irtalb=iret - if(iret.eq.1) then + irtalb = iret + if(iret == 1) then write(6,*) 'albedo analysis read error' call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then + elseif(iret == -1) then + if (me == 0) then print *,'old albedo analysis provided, indicating proper', & ' file name is given. no error suspected.' write(6,*) 'forecast guess will be used' endif else - if (me .eq. 0 .and. kk .eq. 4) + if (me == 0 .and. kk == 4) & print *,'albedo analysis provided.' endif enddo else - if (me .eq. 0) then + if (me == 0) then ! print *,'************************************************' print *,'no albedo analysis available. climatology used' endif @@ -3825,30 +3829,30 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, ! ! vegetation fraction for albedo ! - irtalf=0 + irtalf = 0 if(fnalba(1:8).ne.' ') then do kk = 1, 2 call fixrda(lugb,fnalba,kpdalf(kk),slmask, & iy,im,id,ih,fh,alfanl(1,kk),len,iret &, imsk, jmsk, slmskh, gaus,blno, blto &, outlat, outlon, me) - irtalf=iret - if(iret.eq.1) then + irtalf = iret + if(iret == 1) then write(6,*) 'albedo analysis read error' call abort - elseif(iret.eq.-1) then - if (me .eq. 0) then + elseif(iret == -1) then + if (me == 0) then print *,'old albedo analysis provided, indicating proper', & ' file name is given. no error suspected.' write(6,*) 'forecast guess will be used' endif else - if (me .eq. 0 .and. kk .eq. 4) + if (me == 0 .and. kk == 4) & print *,'albedo analysis provided.' endif enddo else - if (me .eq. 0) then + if (me == 0) then ! print *,'************************************************' print *,'no vegfalbedo analysis available. climatology used' endif @@ -4336,53 +4340,45 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil, ! return end - subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, - & tg3fcs,cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, - & vegfcs, vetfcs, sotfcs, alffcs, -!cwu [+1l] add ()fcs for sih, sic - & sihfcs,sicfcs, -!clu [+1l] add ()fcs for vmn, vmx, slp, abs - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsfanl,wetanl,snoanl,zoranl,albanl, - & tg3anl,cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,aisanl, - & veganl, vetanl, sotanl, alfanl, -!cwu [+1l] add ()anl for sih, sic - & sihanl,sicanl, -!clu [+1l] add ()anl for vmn, vmx, slp, abs - & vmnanl,vmxanl,slpanl,absanl, + subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & + & tg3fcs,cvfcs ,cvbfcs,cvtfcs, & + & cnpfcs,smcfcs,stcfcs,slifcs,aisfcs, & + & vegfcs, vetfcs, sotfcs, alffcs, & + & sihfcs,sicfcs, & !cwu [+1l] add ()fcs for sih, sic + & vmnfcs,vmxfcs,slpfcs,absfcs, & !clu [+1l] add ()fcs for vmn, vmx, slp, abs + & tsfanl,wetanl,snoanl,zoranl,albanl, & + & tg3anl,cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,aisanl, & + & veganl, vetanl, sotanl, alfanl, & + & sihanl,sicanl, & !cwu [+1l] add ()anl for sih, sic + & vmnanl,vmxanl,slpanl,absanl, & !clu [+1l] add ()anl for vmn, vmx, slp, abs & len,lsoil) ! use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil - real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len), - & zorfcs(len),albfcs(len,4),aisfcs(len), - & tg3fcs(len), - & cvfcs (len),cvbfcs(len),cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len),vegfcs(len), - & vetfcs(len),sotfcs(len),alffcs(len,2) -!cwu [+1l] add ()fcs for sih, sic - &, sihfcs(len),sicfcs(len) -!clu [+1l] add ()fcs for vmn, vmx, slp, abs + real (kind=kind_io8) tsffcs(len),wetfcs(len),snofcs(len), & + & zorfcs(len),albfcs(len,4),aisfcs(len), & + & tg3fcs(len), & + & cvfcs (len),cvbfcs(len),cvtfcs(len), & + & cnpfcs(len), & + & smcfcs(len,lsoil),stcfcs(len,lsoil), & + & slifcs(len),vegfcs(len), & + & vetfcs(len),sotfcs(len),alffcs(len,2) & + &, sihfcs(len),sicfcs(len) & &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len), - & zoranl(len),albanl(len,4),aisanl(len), - & tg3anl(len), - & cvanl (len),cvbanl(len),cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len),veganl(len), - & vetanl(len),sotanl(len),alfanl(len,2) -!cwu [+1l] add ()anl for sih, sic - &, sihanl(len),sicanl(len) -!clu [+1l] add ()anl for vmn, vmx, slp, abs + real (kind=kind_io8) tsfanl(len),wetanl(len),snoanl(len), & + & zoranl(len),albanl(len,4),aisanl(len), & + & tg3anl(len), & + & cvanl (len),cvbanl(len),cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len),veganl(len), & + & vetanl(len),sotanl(len),alfanl(len,2) & + &, sihanl(len),sicanl(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! - write(6,*) ' this is a dead start run, tsfc over land is', + write(6,*) ' this is a dead start run, tsfc over land is', & & ' set as lowest sigma level temperture if given.' write(6,*) ' if not, set to climatological tsf over land is used' ! @@ -4433,7 +4429,7 @@ subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil,k - real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), + real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), & & slianl(len) ! ! note that smfcs comes in with the original unit (cm?) (not grib file) @@ -4456,43 +4452,97 @@ subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) ! return end - subroutine rof01(aisfld,len,op,crit) + subroutine rof01(aisfld, len, op, crit) use machine , only : kind_io8,kind_io4 implicit none integer i,len real (kind=kind_io8) aisfld(len),crit character*2 op ! - if(op.eq.'ge') then + if(op == 'ge') then + do i=1,len + if(aisfld(i) >= crit) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'gt') then + do i=1,len + if(aisfld(i) > crit) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'le') then + do i=1,len + if(aisfld(i) <= crit) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + elseif(op == 'lt') then + do i=1,len + if(aisfld(i) < crit) then + aisfld(i) = 1. + else + aisfld(i) = 0. + endif + enddo + else + write(6,*) ' illegal operator in rof01. op=',op + call abort + endif +! + return + end + subroutine rof01_len(aisfld, len, op, lake, critl, crits) + use machine , only : kind_io8,kind_io4 + implicit none + integer i,len + logical :: lake(len) + real (kind=kind_io8) aisfld(len), critl, crits, crit(len) + character*2 op +! + do i=1,len + if (lake(i)) then + crit(i) = critl + else + crit(i) = crits + endif + enddo + if(op == 'ge') then do i=1,len - if(aisfld(i).ge.crit) then - aisfld(i)=1. + if(aisfld(i) >= crit(i)) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'gt') then + elseif(op == 'gt') then do i=1,len - if(aisfld(i).gt.crit) then - aisfld(i)=1. + if(aisfld(i) > crit(i)) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'le') then + elseif(op == 'le') then do i=1,len - if(aisfld(i).le.crit) then - aisfld(i)=1. + if(aisfld(i) <= crit(i)) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo - elseif(op.eq.'lt') then + elseif(op == 'lt') then do i=1,len - if(aisfld(i).lt.crit) then - aisfld(i)=1. + if(aisfld(i) < crit(i)) then + aisfld(i) = 1. else - aisfld(i)=0. + aisfld(i) = 0. endif enddo else @@ -4517,7 +4567,7 @@ subroutine tsfcor(tsfc,orog,slmask,umask,len,rlapse) enddo return end - subroutine snodpth(scvanl,slianl,tsfanl,snoclm, + subroutine snodpth(scvanl,slianl,tsfanl,snoclm, & & glacir,snwmax,snwmin,landice,len,snoanl, me) use machine , only : kind_io8,kind_io4 implicit none @@ -4525,7 +4575,7 @@ subroutine snodpth(scvanl,slianl,tsfanl,snoclm, logical, intent(in) :: landice real (kind=kind_io8) sno,snwmax,snwmin ! - real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len), + real (kind=kind_io8) scvanl(len), slianl(len), tsfanl(len), & & snoclm(len), snoanl(len), glacir(len) ! if (me .eq. 0) write(6,*) 'snodpth' @@ -4571,80 +4621,80 @@ subroutine snodpth(scvanl,slianl,tsfanl,snoclm, enddo return end subroutine snodpth - subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, - & sihfcs,sicfcs, - & vmnfcs,vmxfcs,slpfcs,absfcs, - & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, - & cvfcs ,cvbfcs,cvtfcs, - & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, - & vetfcs,sotfcs,alffcs, - & sihanl,sicanl, - & vmnanl,vmxanl,slpanl,absanl, - & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl, - & cvanl ,cvbanl,cvtanl, - & cnpanl,smcanl,stcanl,slianl,veganl, - & vetanl,sotanl,alfanl, - & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, - & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, - & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, - & calfl,calfs, - & csihl,csihs,csicl,csics, - & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, - & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, - & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, - & irtvmn,irtvmx,irtslp,irtabs, + subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & + & sihfcs,sicfcs, & + & vmnfcs,vmxfcs,slpfcs,absfcs, & + & tsffcs,wetfcs,snofcs,zorfcs,albfcs,aisfcs, & + & cvfcs ,cvbfcs,cvtfcs, & + & cnpfcs,smcfcs,stcfcs,slifcs,vegfcs, & + & vetfcs,sotfcs,alffcs, & + & sihanl,sicanl, & + & vmnanl,vmxanl,slpanl,absanl, & + & tsfanl,tsfan2,wetanl,snoanl,zoranl,albanl,aisanl,& + & cvanl ,cvbanl,cvtanl, & + & cnpanl,smcanl,stcanl,slianl,veganl, & + & vetanl,sotanl,alfanl, & + & ctsfl,calbl,caisl,csnol,csmcl,czorl,cstcl,cvegl, & + & ctsfs,calbs,caiss,csnos,csmcs,czors,cstcs,cvegs, & + & ccv,ccvb,ccvt,ccnp,cvetl,cvets,csotl,csots, & + & calfl,calfs, & + & csihl,csihs,csicl,csics, & + & cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps,cabsl,cabss, & + & irttsf,irtwet,irtsno,irtzor,irtalb,irtais, & + & irttg3,irtscv,irtacn,irtsmc,irtstc,irtveg, & + & irtvmn,irtvmx,irtslp,irtabs, & & irtvet,irtsot,irtalf, landice, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : veg_type_landice, soil_type_landice implicit none - integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, - & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, - & irtalb,irtsno,irttsf,irtwet,j + integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, & + & irttg3,irtstc,irtalf,me,irtsot,irtveg,irtvet, irtzor, & + & irtalb,irtsno,irttsf,irtwet,j & &, irtvmn,irtvmx,irtslp,irtabs logical, intent(in) :: landice - real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp, - & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl, - & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl, - & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt, - & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl, - & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl, - & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl, - & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol, - & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl, - & cvets,calfs,deltsfc, - & csihl,csihs,csicl,csics, - & rsihl,rsihs,rsicl,rsics, - & qsihl,qsihs,qsicl,qsics - &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps - &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs - &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns + real (kind=kind_io8) rvegs,rvets,rzors,raiss,rsnos,rsots,rcnp, & + & rcvt,rcv,rcvb,rsnol,rzorl,raisl,ralbl, & + & ralfl,rvegl,ralbs,ralfs,rtsfs,rvetl,rsotl, & + & qzors,qvegs,qsnos,qalfs,qaiss,qvets,qcvt, & + & qcnp,qcvb,qsots,qcv,qaisl,qsnol,qalfl, & + & qtsfl,qalbl,qzorl,qtsfs,qalbs,qsotl,qvegl, & + & qvetl,rtsfl,calbs,caiss,ctsfs,czorl,cvegl, & + & csnos,ccvb,ccvt,ccv,czors,cvegs,caisl,csnol, & + & calbl,fh,ctsfl,ccnp,csots,calfl,csotl,cvetl, & + & cvets,calfs,deltsfc, & + & csihl,csihs,csicl,csics, & + & rsihl,rsihs,rsicl,rsics, & + & qsihl,qsihs,qsicl,qsics & + &, cvmnl,cvmns,cvmxl,cvmxs,cslpl,cslps & + &, cabsl,cabss,rvmnl,rvmns,rvmxl,rvmxs & + &, rslpl,rslps,rabsl,rabss,qvmnl,qvmns & &, qvmxl,qvmxs,qslpl,qslps,qabsl,qabss ! - real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), - & zorfcs(len), albfcs(len,4), aisfcs(len), - & cvfcs (len), cvbfcs(len), cvtfcs(len), - & cnpfcs(len), - & smcfcs(len,lsoil),stcfcs(len,lsoil), - & slifcs(len), vegfcs(len), - & vetfcs(len), sotfcs(len), alffcs(len,2) - &, sihfcs(len), sicfcs(len) + real (kind=kind_io8) tsffcs(len), wetfcs(len), snofcs(len), & + & zorfcs(len), albfcs(len,4), aisfcs(len), & + & cvfcs (len), cvbfcs(len), cvtfcs(len), & + & cnpfcs(len), & + & smcfcs(len,lsoil),stcfcs(len,lsoil), & + & slifcs(len), vegfcs(len), & + & vetfcs(len), sotfcs(len), alffcs(len,2) & + &, sihfcs(len), sicfcs(len) & &, vmnfcs(len),vmxfcs(len),slpfcs(len),absfcs(len) - real (kind=kind_io8) tsfanl(len),tsfan2(len), - & wetanl(len),snoanl(len), - & zoranl(len), albanl(len,4), aisanl(len), - & cvanl (len), cvbanl(len), cvtanl(len), - & cnpanl(len), - & smcanl(len,lsoil),stcanl(len,lsoil), - & slianl(len), veganl(len), - & vetanl(len), sotanl(len), alfanl(len,2) - &, sihanl(len),sicanl(len) + real (kind=kind_io8) tsfanl(len),tsfan2(len), & + & wetanl(len),snoanl(len), & + & zoranl(len), albanl(len,4), aisanl(len), & + & cvanl (len), cvbanl(len), cvtanl(len), & + & cnpanl(len), & + & smcanl(len,lsoil),stcanl(len,lsoil), & + & slianl(len), veganl(len), & + & vetanl(len), sotanl(len), alfanl(len,2) & + &, sihanl(len),sicanl(len) & &, vmnanl(len),vmxanl(len),slpanl(len),absanl(len) ! - real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil), + real (kind=kind_io8) csmcl(lsoil), csmcs(lsoil), & & cstcl(lsoil), cstcs(lsoil) - real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil), + real (kind=kind_io8) rsmcl(lsoil), rsmcs(lsoil), & & rstcl(lsoil), rstcs(lsoil) - real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), + real (kind=kind_io8) qsmcl(lsoil), qsmcs(lsoil), & & qstcl(lsoil), qstcs(lsoil) logical first integer num_threads @@ -5022,18 +5072,17 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, !$omp end parallel do return end subroutine merge - subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, -!cwu [+1l] add sihnew,sicnew,sihanl,sicanl - & sihnew,sicnew,sihanl,sicanl, - & albanl,snoanl,zoranl,smcanl,stcanl, - & albsea,snosea,zorsea,smcsea,smcice, - & tsfmin,tsfice,albice,zorice,tgice, + subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, & + & sihnew,sicnew,sihanl,sicanl, & !cwu [+1l] add sihnew,sicnew,sihanl,sicanl + & albanl,snoanl,zoranl,smcanl,stcanl, & + & albsea,snosea,zorsea,smcsea,smcice, & + & tsfmin,tsfice,albice,zorice,tgice, & & rla,rlo,me) ! use machine , only : kind_io8,kind_io4 implicit none real (kind=kind_io8), parameter :: one=1.0 - real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea, + real (kind=kind_io8) tgice,albice,zorice,tsfice,albsea,snosea, & & smcice,tsfmin,zorsea,smcsea !cwu [+1l] add sicnew,sihnew &, sicnew,sihnew @@ -5118,7 +5167,7 @@ subroutine newice(slianl,slifcs,tsfanl,tsffcs,len,lsoil, ! return end - subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, + subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, & & landice,me) use machine , only : kind_io8,kind_io4 implicit none @@ -5164,20 +5213,20 @@ subroutine qcsnow(snoanl,slmask,aisanl,glacir,len,snoval, endif return end subroutine qcsnow - subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, + subroutine qcsice(ais,glacir,amxice,aicice,aicsea,sllnd,slmask, & & rla,rlo,len,me) use machine , only : kind_io8,kind_io4 implicit none integer kount1,kount,i,me,len real (kind=kind_io8) per,aicsea,aicice,sllnd ! - real (kind=kind_io8) ais(len), glacir(len), + real (kind=kind_io8) ais(len), glacir(len), & & amxice(len), slmask(len) real (kind=kind_io8) rla(len), rlo(len) ! ! check sea-ice cover mask against land-sea mask ! - if (me .eq. 0) write(6,*) 'qc of sea ice' + if (me == 0) write(6,*) 'qc of sea ice' kount = 0 kount1 = 0 do i=1,len @@ -5275,9 +5324,8 @@ subroutine setlsi(slmask,aisfld,len,aicice,slifld) ! do i=1,len slifld(i) = slmask(i) -! if(aisfld(i).eq.aicice) slifld(i) = 2.0 - if(aisfld(i).eq.aicice .and. slmask(i) .eq. 0.0) - & slifld(i) = 2.0 + if(aisfld(i) == aicice .and. slmask(i) == 0.0) & + & slifld(i) = 2.0 enddo return end @@ -5292,66 +5340,63 @@ subroutine scale(fld,len,scl) enddo return end - subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, - & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn, - & fldjmx,fldjmn,fldsmx,fldsmn,epsfld, + subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & + & fldlmx,fldlmn,fldomx,fldomn,fldimx,fldimn, & + & fldjmx,fldjmn,fldsmx,fldsmn,epsfld, & & rla,rlo,len,mode,percrit,lgchek,me) ! use machine , only : kind_io8,kind_io4 implicit none - real (kind=kind_io8) permax,per,fldimx,fldimn,fldjmx,fldomn, - & fldlmx,fldlmn,fldomx,fldjmn,percrit, - & fldsmx,fldsmn,epsfld - integer kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,mmprt,kminj, - & ij,nprt,kmaxs,kmins,i,me,len,mode - parameter(mmprt=2) + integer, intent(in) :: len, mode, me + real (kind=kind_io8), intent(in) :: fldimx,fldimn,fldjmx,fldomn, & + & fldlmx,fldlmn,fldomx,fldjmn, & + & fldsmx,fldsmn,epsfld,percrit & + integer, parameter :: mmprt=2 ! character*8 ttl logical iceflg(len) - real (kind=kind_io8) fld(len),slimsk(len),sno(len), - & rla(len), rlo(len) - integer iwk(len) + real (kind=kind_io8), dimension(len) :: fld, slimsk, sno, rla, rlo logical lgchek ! logical first integer num_threads + real (kind=kind_io8) permax, per data first /.true./ save num_threads, first ! - integer len_thread_m, i1_t, i2_t, it - integer num_parthds + integer :: len_thread_m, i1_t, i2_t, it, num_parthds, & + & kmaxi,kmini,kmaxj,kmino,kmaxl,kminl,kmaxo,kminj, & + & ij,nprt,kmaxs,kmins,i + integer :: islimsk(len), iwk(len) ! if (first) then num_threads = num_parthds() first = .false. endif + do it=1,len + islimsk(it) = nint(slimsk(it)) + enddo ! ! check against land-sea mask and ice cover mask ! - if(me .eq. 0) then -! print *,' ' - print *,'performing qc of ',ttl,' mode=',mode, - & '(0=count only, 1=replace)' + if(me == 0) then + print *,'performing qc of ',ttl,' mode=',mode, + & '(0=count only, 1=replace)' endif ! len_thread_m = (len+num_threads-1) / num_threads - kmaxl = 0 - kminl = 0 - kmaxo = 0 - kmino = 0 - kmaxi = 0 - kmini = 0 - kmaxj = 0 - kminj = 0 - kmaxs = 0 - kmins = 0 + + kmaxl = 0 ; kminl = 0 ; kmaxo = 0 ; kmino = 0 + kmaxi = 0 ; kmini = 0 ; kmaxj = 0 ; kminj = 0 + kmaxs = 0 ; kmins = 0 + !$omp parallel do private(i1_t,i2_t,it,i) !$omp+private(nprt,ij,iwk) !$omp+reduction(+:kmaxs,kmins,kmaxl,kminl,kmaxo) !$omp+reduction(+:kmino,kmaxi,kmini,kmaxj,kminj) !$omp+shared(mode,epsfld) !$omp+shared(fldlmx,fldlmn,fldomx,fldjmn,fldsmx,fldsmn) -!$omp+shared(fld,slimsk,sno,rla,rlo) +!$omp+shared(fld,islimsk,sno,rla,rlo) do it=1,num_threads ! start of threaded loop i1_t = (it-1)*len_thread_m+1 i2_t = min(i1_t+len_thread_m-1,len) @@ -5360,24 +5405,24 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! lower bound check over bare land ! - if (fldlmn .ne. 999.0) then + if (fldlmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).lt.fldlmn-epsfld) then - kminl=kminl+1 + if(islimsk(i) == 1 .and. sno(i) <= 0.0 & + & .and. fld(i) < fldlmn-epsfld) then + kminl = kminl + 1 iwk(kminl) = i endif enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then + if(me == 0 .and. it == 1 .and. num_threads == 1) then nprt = min(mmprt,kminl) do i=1,nprt ij = iwk(i) print 8001,rla(ij),rlo(ij),fld(ij),fldlmn - 8001 format(' bare land min. check. lat=',f5.1, + 8001 format(' bare land min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kminl fld(iwk(i)) = fldlmn enddo @@ -5386,11 +5431,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! upper bound check over bare land ! - if (fldlmx .ne. 999.0) then + if (fldlmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).le.0..and. - & fld(i).gt.fldlmx+epsfld) then - kmaxl=kmaxl+1 + if(islimsk(i) == 1 .and. sno(i) <= 0.0 & + & .and. fld(i) > fldlmx+epsfld) then + kmaxl = kmaxl + 1 iwk(kmaxl) = i endif enddo @@ -5399,11 +5444,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8002,rla(ij),rlo(ij),fld(ij),fldlmx - 8002 format(' bare land max. check. lat=',f5.1, + 8002 format(' bare land max. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e13.6, ' to ',e13.6) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxl fld(iwk(i)) = fldlmx enddo @@ -5412,11 +5457,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! lower bound check over snow covered land ! - if (fldsmn .ne. 999.0) then + if (fldsmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).lt.fldsmn-epsfld) then - kmins=kmins+1 + if(islimsk(i) == 1 .and. sno(i) > 0.0 & + & .and. fld(i) < fldsmn-epsfld) then + kmins = kmins + 1 iwk(kmins) = i endif enddo @@ -5425,11 +5470,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8003,rla(ij),rlo(ij),fld(ij),fldsmn - 8003 format(' sno covrd land min. check. lat=',f5.1, + 8003 format(' sno covrd land min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmins fld(iwk(i)) = fldsmn enddo @@ -5438,11 +5483,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! upper bound check over snow covered land ! - if (fldsmx .ne. 999.0) then + if (fldsmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.1..and.sno(i).gt.0..and. - & fld(i).gt.fldsmx+epsfld) then - kmaxs=kmaxs+1 + if(islimsk(i) == 1 .and. sno(i) > 0.0 & + & .and. fld(i) > fldsmx+epsfld) then + kmaxs = kmaxs + 1 iwk(kmaxs) = i endif enddo @@ -5451,11 +5496,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8004,rla(ij),rlo(ij),fld(ij),fldsmx - 8004 format(' snow land max. check. lat=',f5.1, + 8004 format(' snow land max. check. lat=',f5.1,i & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxs fld(iwk(i)) = fldsmx enddo @@ -5464,11 +5509,10 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! lower bound check over open ocean ! - if (fldomn .ne. 999.0) then + if (fldomn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.0..and. - & fld(i).lt.fldomn-epsfld) then - kmino=kmino+1 + if(islimsk(i) == 0.0 .and. fld(i) < fldomn-epsfld) then + kmino = kmino + 1 iwk(kmino) = i endif enddo @@ -5477,11 +5521,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8005,rla(ij),rlo(ij),fld(ij),fldomn - 8005 format(' open ocean min. check. lat=',f5.1, + 8005 format(' open ocean min. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4,' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmino fld(iwk(i)) = fldomn enddo @@ -5490,24 +5534,23 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! upper bound check over open ocean ! - if (fldomx .ne. 999.0) then + if (fldomx /= 999.0) then do i=i1_t,i2_t - if(fldomx.ne.999..and.slimsk(i).eq.0..and. - & fld(i).gt.fldomx+epsfld) then - kmaxo=kmaxo+1 + if(islimsk(i) ==.0 .and. fld(i) > fldomx+epsfld) then + kmaxo = kmaxo+1 iwk(kmaxo) = i endif enddo - if(me == 0 . and. it == 1 .and. num_threads == 1) then + if(me == 0 .and. it == 1 .and. num_threads == 1) then nprt = min(mmprt,kmaxo) do i=1,nprt ij = iwk(i) print 8006,rla(ij),rlo(ij),fld(ij),fldomx - 8006 format(' open ocean max. check. lat=',f5.1, + 8006 format(' open ocean max. check. lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxo fld(iwk(i)) = fldomx enddo @@ -5516,11 +5559,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! lower bound check over sea ice without snow ! - if (fldimn .ne. 999.0) then + if (fldimn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).lt.fldimn-epsfld) then - kmini=kmini+1 + if(islimsk(i) == 2 .and. sno(i) <= 0.0 & + & .and. fld(i) < fldimn-epsfld) then + kmini = kmini + 1 iwk(kmini) = i endif enddo @@ -5529,11 +5572,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8007,rla(ij),rlo(ij),fld(ij),fldimn - 8007 format(' seaice no snow min. check lat=',f5.1, + 8007 format(' seaice no snow min. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmini fld(iwk(i)) = fldimn enddo @@ -5542,12 +5585,12 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! upper bound check over sea ice without snow ! - if (fldimx .ne. 999.0) then + if (fldimx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).le.0..and. - & fld(i).gt.fldimx+epsfld .and. iceflg(i)) then + if(islimsk(i) == 2 .and. sno(i) <= 0.0 .and. & + & fld(i) > fldimx+epsfld .and. iceflg(i)) then ! & fld(i).gt.fldimx+epsfld) then - kmaxi=kmaxi+1 + kmaxi = kmaxi + 1 iwk(kmaxi) = i endif enddo @@ -5556,11 +5599,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8008,rla(ij),rlo(ij),fld(ij),fldimx - 8008 format(' seaice no snow max. check lat=',f5.1, + 8008 format(' seaice no snow max. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxi fld(iwk(i)) = fldimx enddo @@ -5569,11 +5612,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! lower bound check over sea ice with snow ! - if (fldjmn .ne. 999.0) then + if (fldjmn /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).lt.fldjmn-epsfld) then - kminj=kminj+1 + if(islimsk(i) == 2 .and. sno(i) > 0.0 .and. & + & fld(i) < fldjmn-epsfld) then + kminj = kminj + 1 iwk(kminj) = i endif enddo @@ -5582,11 +5625,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8009,rla(ij),rlo(ij),fld(ij),fldjmn - 8009 format(' sea ice snow min. check lat=',f5.1, + 8009 format(' sea ice snow min. check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kminj fld(iwk(i)) = fldjmn enddo @@ -5595,12 +5638,12 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! upper bound check over sea ice with snow ! - if (fldjmx .ne. 999.0) then + if (fldjmx /= 999.0) then do i=i1_t,i2_t - if(slimsk(i).eq.2..and.sno(i).gt.0..and. - & fld(i).gt.fldjmx+epsfld .and. iceflg(i)) then + if(islimsk(i) == 2 .and.sno(i) > 0.0 .and. & + & fld(i)> fldjmx+epsfld .and. iceflg(i)) then ! & fld(i).gt.fldjmx+epsfld) then - kmaxj=kmaxj+1 + kmaxj = kmaxj+1 iwk(kmaxj) = i endif enddo @@ -5609,11 +5652,11 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, do i=1,nprt ij = iwk(i) print 8010,rla(ij),rlo(ij),fld(ij),fldjmx - 8010 format(' seaice snow max check lat=',f5.1, + 8010 format(' seaice snow max check lat=',f5.1, & & ' lon=',f6.1,' fld=',e11.4, ' to ',e11.4) enddo endif - if (mode .eq. 1) then + if (mode == 1) then do i=1,kmaxj fld(iwk(i)) = fldjmx enddo @@ -5624,78 +5667,77 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, ! ! print results ! - if(me .eq. 0) then -! write(6,*) 'summary of qc' - permax=0. - if(kminl.gt.0) then - per=float(kminl)/float(len)*100. + if(me == 0) then + permax = 0.0 + if(kminl > 0) then + per = float(kminl)/float(len)*100. print 9001,fldlmn,kminl,per - 9001 format(' bare land min check. modified to ',f8.1, + 9001 format(' bare land min check. modified to ',f8.1, & & ' at ',i5,' points ',f8.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax = per endif - if(kmaxl.gt.0) then - per=float(kmaxl)/float(len)*100. + if(kmaxl > 0) then + per = float(kmaxl)/float(len)*100. print 9002,fldlmx,kmaxl,per - 9002 format(' bare land max check. modified to ',f8.1, + 9002 format(' bare land max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmino.gt.0) then - per=float(kmino)/float(len)*100. + if(kmino > 0) then + per = float(kmino)/float(len)*100. print 9003,fldomn,kmino,per - 9003 format(' open ocean min check. modified to ',f8.1, + 9003 format(' open ocean min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxo.gt.0) then - per=float(kmaxo)/float(len)*100. + if(kmaxo > 0) then + per = float(kmaxo)/float(len)*100. print 9004,fldomx,kmaxo,per - 9004 format(' open sea max check. modified to ',f8.1, + 9004 format(' open sea max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmins.gt.0) then - per=float(kmins)/float(len)*100. + if(kmins >.0) then + per = float(kmins)/float(len)*100. print 9009,fldsmn,kmins,per - 9009 format(' snow covered land min check. modified to ',f8.1, + 9009 format(' snow covered land min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxs.gt.0) then - per=float(kmaxs)/float(len)*100. + if(kmaxs > 0) then + per = float(kmaxs)/float(len)*100. print 9010,fldsmx,kmaxs,per - 9010 format(' snow covered land max check. modified to ',f8.1, + 9010 format(' snow covered land max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmini.gt.0) then - per=float(kmini)/float(len)*100. + if(kmini > 0) then + per = float(kmini)/float(len)*100. print 9005,fldimn,kmini,per - 9005 format(' bare ice min check. modified to ',f8.1, + 9005 format(' bare ice min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxi.gt.0) then - per=float(kmaxi)/float(len)*100. + if(kmaxi > 0) then + per = float(kmaxi)/float(len)*100. print 9006,fldimx,kmaxi,per - 9006 format(' bare ice max check. modified to ',f8.1, + 9006 format(' bare ice max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax=per endif - if(kminj.gt.0) then - per=float(kminj)/float(len)*100. + if(kminj > 0) then + per = float(kminj)/float(len)*100. print 9007,fldjmn,kminj,per - 9007 format(' snow covered ice min check. modified to ',f8.1, + 9007 format(' snow covered ice min check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') if(per.gt.permax) permax=per endif - if(kmaxj.gt.0) then - per=float(kmaxj)/float(len)*100. + if(kmaxj > 0) then + per = float(kmaxj)/float(len)*100. print 9008,fldjmx,kmaxj,per - 9008 format(' snow covered ice max check. modified to ',f8.1, + 9008 format(' snow covered ice max check. modified to ',f8.1, & & ' at ',i5,' points ',f4.1,'percent') - if(per.gt.permax) permax=per + if(per > permax) permax=per endif ! commented on 06/30/99 -- moorthi ! if(lgchek) then @@ -5784,7 +5826,7 @@ subroutine getsmc(wetfld,len,lsoil,smcfld,me) enddo return end - subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl, + subroutine usesgt(sig1t,slianl,tg3anl,len,lsoil,tsfanl,stcanl, & & tsfimx) ! use machine , only : kind_io8,kind_io4 @@ -5930,23 +5972,21 @@ subroutine qcsli(slianl,slifcs,len,me) !1111 format(80i1) ! return ! end - subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, - & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, - & zoranl,smcanl, - & smcclm,tsfsmx,albomx,zoromx, me) + subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, & + & len,lsoil,snoanl,aisanl,slianl,tsfanl,albanl, & + & zoranl,smcanl,smcclm,tsfsmx,albomx,zoromx, me) ! use machine , only : kind_io8,kind_io4 implicit none integer kount,me,k,i,lsoil,len real (kind=kind_io8) zoromx,per,albomx,qctsfi,qcsnos,qctsfs,tsfsmx real (kind=kind_io8) tsffcs(len), snofcs(len) - real (kind=kind_io8) snoanl(len), aisanl(len), - & slianl(len), zoranl(len), - & tsfanl(len), albanl(len,4), - & smcanl(len,lsoil) - real (kind=kind_io8) smcclm(len,lsoil) + real (kind=kind_io8) snoanl(len), aisanl(len), & + & slianl(len), zoranl(len), & + & tsfanl(len), albanl(len,4), & + & smcanl(len,lsoil), smcclm(len,lsoil) ! - if (me .eq. 0) write(6,*) 'qc of snow and sea-ice analysis' + if (me == 0) write(6,*) 'qc of snow and sea-ice analysis' ! ! qc of snow analysis ! @@ -5954,7 +5994,7 @@ subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, ! kount = 0 do i=1,len - if(slianl(i).gt.0..and. + if(slianl(i).gt.0..and. & & tsffcs(i).gt.qctsfs.and.snoanl(i).gt.0.) then kount = kount + 1 snoanl(i) = 0. @@ -6026,8 +6066,8 @@ subroutine qcbyfc(tsffcs,snofcs,qctsfs,qcsnos,qctsfi, ! return end - subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, - & data,imax,jmax,rlnout,rltout,lmask,rslmsk + subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & + & data,imax,jmax,rlnout,rltout,lmask,rslmsk & &, gaus,blno, blto, kgds1, kpds4, lbms) use machine , only : kind_io8,kind_io4 use sfccyc_module @@ -6507,25 +6547,25 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, ! return end - subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, + subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & & wlon,rnlat,rlnout,rltout,gaus,blno, blto) use machine , only : kind_io8,kind_io4 implicit none - integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, + integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, & & j,iret - real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon, - & rnlat,dxout,dphi,dlat,facns,tem,blno, + real (kind=kind_io8) alamd,dxin,aphi,x,sum1,sum2,y,dlati,wlon, & + & rnlat,dxout,dphi,dlat,facns,tem,blno, & & blto ! ! interpolation from lat/lon grid to other lat/lon grid ! - real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout) + real (kind=kind_io8) gauin (imxin,jmxin), regout(imxout,jmxout) & &, rlnout(imxout), rltout(jmxout) logical gaus ! real, allocatable :: gaul(:) real (kind=kind_io8) ddx(imxout),ddy(jmxout) - integer iindx1(imxout), iindx2(imxout), + integer iindx1(imxout), iindx2(imxout), & & jindx1(jmxout), jindx2(jmxout) integer jmxsav,n,kspla data jmxsav/0/ @@ -6757,8 +6797,8 @@ subroutine landtyp(vegtype,soiltype,slptype,slmask,len) use machine , only : kind_io8,kind_io4 implicit none integer i,len - real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len) - +, slptype(len) + real (kind=kind_io8) vegtype(len),soiltype(len),slmask(len) & + &, slptype(len) ! ! make sure that the soil type and veg type are non-zero over land ! @@ -6800,7 +6840,7 @@ subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) use machine , only : kind_io8,kind_io4 implicit none integer i,len - real (kind=kind_io8) tsfanl(len), tsfan0(len), + real (kind=kind_io8) tsfanl(len), tsfan0(len), & & tsfclm(len), tsfcl0(len) ! ! time interpolation of anomalies @@ -6812,53 +6852,53 @@ subroutine anomint(tsfan0,tsfclm,tsfcl0,tsfanl,len) enddo return end - subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, - & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc, - & fnvmnc,fnvmxc,fnslpc,fnabsc, - & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm, - & tg3clm,cvclm ,cvbclm,cvtclm, - & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm, - & vetclm,sotclm,alfclm, - & vmnclm,vmxclm,slpclm,absclm, - & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, - & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, - & kpdvet,kpdsot,kpdalf,tsfcl0, - & kpdvmn,kpdvmx,kpdslp,kpdabs, - & deltsfc, lanom - &, imsk, jmsk, slmskh, outlat, outlon - &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb + subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & + & slmask,fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc,& + & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, & + & fnvetc,fnsotc, & + & fnvmnc,fnvmxc,fnslpc,fnabsc, & + & tsfclm,tsfcl2,wetclm,snoclm,zorclm,albclm,aisclm,& + & tg3clm,cvclm ,cvbclm,cvtclm, & + & cnpclm,smcclm,stcclm,sliclm,scvclm,acnclm,vegclm,& + & vetclm,sotclm,alfclm, & + & vmnclm,vmxclm,slpclm,absclm, & + & kpdtsf,kpdwet,kpdsno,kpdzor,kpdalb,kpdais, & + & kpdtg3,kpdscv,kpdacn,kpdsmc,kpdstc,kpdveg, & + & kpdvet,kpdsot,kpdalf,tsfcl0, & + & kpdvmn,kpdvmx,kpdslp,kpdabs, & + & deltsfc, lanom & + &, imsk, jmsk, slmskh, outlat, outlon & + &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb & &, tile_num_ch, i_index, j_index) ! use machine , only : kind_io8,kind_io4 implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) - real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, + real (kind=kind_io8) rjday,wei1x,wei2x,rjdayh,wei2m,wei1m,wei1s, & & wei2s,fh,stcmon1s,blto,blno,deltsfc,rjdayh2 real (kind=kind_io8) wei1y,wei2y - integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, - & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, - & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, - & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, - & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb + integer jdoy,jday,jh,jdow,mmm,mmp,mm,iret,monend,i,k,jm,jd,iy4, & + & jy,mon1,is2,isx,kpd9,is1,l,nn,mon2,mon,is,kpdsno, & + & kpdzor,kpdtsf,kpdwet,kpdscv,kpdacn,kpdais,kpdtg3,im,id, & + & lugb,iy,len,lsoil,ih,kpdsmc,iprnt,me,m1,m2,k1,k2, & + & kpdvet,kpdsot,kpdstc,kpdveg,jmsk,imsk,j,ialb & &, kpdvmn,kpdvmx,kpdslp,kpdabs,landice_cat integer kpdalb(4), kpdalf(2) ! - character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, - & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, - & fnvetc,fnsotc,fnalbc2 + character*500 fntsfc,fnwetc,fnsnoc,fnzorc,fnalbc,fnaisc, & + & fntg3c,fnscvc,fnsmcc,fnstcc,fnacnc,fnvegc, & + & fnvetc,fnsotc,fnalbc2 & &, fnvmnc,fnvmxc,fnslpc,fnabsc - real (kind=kind_io8) tsfclm(len),tsfcl2(len), - & wetclm(len),snoclm(len), - & zorclm(len),albclm(len,4),aisclm(len), - & tg3clm(len),acnclm(len), - & cvclm (len),cvbclm(len),cvtclm(len), - & cnpclm(len), - & smcclm(len,lsoil),stcclm(len,lsoil), - & sliclm(len),scvclm(len),vegclm(len), - & vetclm(len),sotclm(len),alfclm(len,2) + real (kind=kind_io8) tsfclm(len),tsfcl2(len), & + & wetclm(len),snoclm(len), & + & zorclm(len),albclm(len,4),aisclm(len), & + & tg3clm(len),acnclm(len), & + & cvclm (len),cvbclm(len),cvtclm(len), & + & cnpclm(len), & + & smcclm(len,lsoil),stcclm(len,lsoil), & + & sliclm(len),scvclm(len),vegclm(len), & + & vetclm(len),sotclm(len),alfclm(len,2) & &, vmnclm(len),vmxclm(len),slpclm(len),absclm(len) real (kind=kind_io8) slmskh(imsk,jmsk) real (kind=kind_io8) outlat(len), outlon(len) @@ -7982,8 +8022,8 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, ! return end subroutine clima - subroutine fixrdc_tile(filename_raw, tile_num_ch, - & i_index, j_index, kpds, + subroutine fixrdc_tile(filename_raw, tile_num_ch, & + & i_index, j_index, kpds, & & var, mon, npts, me) use netcdf use machine , only : kind_io8 @@ -8132,15 +8172,17 @@ subroutine netcdf_err(error) call abort end subroutine netcdf_err - subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, - & gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto + + + subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & + & gdata,len,iret & + &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata implicit none - integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, - & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami + integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & + & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & &, jj,w3kindreal,w3kindint real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto ! @@ -8308,18 +8350,19 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, deallocate(lbms) return end subroutine fixrdc - subroutine fixrda(lugb,fngrib,kpds5,slmask, - & iy,im,id,ih,fh,gdata,len,iret - &, imsk, jmsk, slmskh, gaus,blno, blto + + subroutine fixrda(lugb,fngrib,kpds5,slmask, & + & iy,im,id,ih,fh,gdata,len,iret & + &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_io4 use sfccyc_module, only : mdata implicit none - integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, - & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, - & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, + integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & + & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & + & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, & & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint - real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, + real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, & & rjday,blto ! ! read in grib climatology/analysis files and interpolate to the input From aef879109dac98d986be09363168a6a93f40c76a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 5 Mar 2020 20:16:14 +0000 Subject: [PATCH 033/217] fixing an openmp error pointed out by Jun wrt z0 --- atmos_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index a0204da0a..987608232 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1672,7 +1672,7 @@ subroutine assign_importdata(rc) if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex) .and. IPD_control%cplwav2atm) then -!$omp parallel do default(shared) private(i,j,nb,ix) +!$omp parallel do default(shared) private(i,j,nb,ix,tem) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) From cfa5e6b8c7360538a0db678891ed26cbf459a1ab Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 9 Mar 2020 14:12:36 +0000 Subject: [PATCH 034/217] renaming DumpFileds in fv3 cap --- ccpp/physics | 2 +- fv3_cap.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index f8eb82ca3..fd0bc5a5d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f8eb82ca3da1e4dfd8665064998ff02279107002 +Subproject commit fd0bc5a5d5baa4bff5c6fb654ed7f52211902e42 diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 1c9136185..2bf718c1d 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -203,7 +203,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & + call ESMF_AttributeGet(gcomp, name="DumpFields_ATM", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return From ca0df2f94bfa0d859d8655b0141c032345b7bd0d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 24 Mar 2020 19:54:03 -0400 Subject: [PATCH 035/217] updted gitmodules --- .gitmodules | 2 +- atmos_cubed_sphere | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 04f33a38b..2827f0fee 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jan102020 + branch = SM_Mar032020 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index db3acfbec..371a29afb 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit db3acfbec2ca00d1795b72b7ebf0b1e308506ced +Subproject commit 371a29afbf813357dd93647cac0cbcd44db2ab20 From f3c9323854cd144a485deb1329b2bc28bb16ecda Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 15 Apr 2020 18:01:09 +0000 Subject: [PATCH 036/217] updating constants to real 8 and a bug fix in MG driver --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 228 +++++---- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 102 ++-- gfsphysics/physics/gcm_shoc.f90 | 41 +- gfsphysics/physics/get_prs.f | 102 ++-- gfsphysics/physics/m_micro_driver.F90 | 471 +++++++++--------- gfsphysics/physics/micro_mg3_0.F90 | 18 +- gfsphysics/physics/micro_mg_utils.F90 | 52 +- gfsphysics/physics/moninshoc.f | 111 +++-- gfsphysics/physics/rascnvv2.f | 360 ++++++------- gfsphysics/physics/sfc_drv.f | 10 +- gfsphysics/physics/sfc_ocean.f | 21 +- 11 files changed, 773 insertions(+), 743 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 9cd0df74a..3b02a4e80 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -17,7 +17,8 @@ module module_physics_driver GFS_sfcprop_type, GFS_coupling_type, & GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type, huge + GFS_radtend_type, GFS_diag_type +! GFS_radtend_type, GFS_diag_type, huge use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_driver, & cloud_diagnosis use module_mp_thompson, only: mp_gt_driver @@ -54,11 +55,12 @@ module module_physics_driver real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, & half = 0.5d0, onebg = one/con_g real(kind=kind_phys), parameter :: albdf = 0.06d0 - real(kind=kind_phys), parameter :: tf=258.16d0, tcr=273.16d0, tcrf=1.0/(tcr-tf) + real(kind=kind_phys), parameter :: tf=258.16d0, tcr=273.16d0, tcrf=one/(tcr-tf) real(kind=kind_phys), parameter :: con_p001= 0.001d0 real(kind=kind_phys), parameter :: con_day = 86400.0d0 real(kind=kind_phys), parameter :: rad2dg = 180.0d0/con_pi real(kind=kind_phys), parameter :: omz1 = 10.0d0 + real(kind=kind_phys), parameter :: huge = zero !> GFS Physics Implementation Layer !> @brief Layer that invokes individual GFS physics routines @@ -1040,7 +1042,7 @@ subroutine GFS_physics_driver & !## CCPP ##* GFS_surface_generic.F90/GFS_surface_generic_pre_run do i = 1, IM - sigmaf(i) = max( Sfcprop%vfrac(i),0.01 ) + sigmaf(i) = max( Sfcprop%vfrac(i),0.01d0 ) islmsk(i) = nint(Sfcprop%slmsk(i)) if (islmsk(i) == 2) then @@ -1125,44 +1127,62 @@ subroutine GFS_physics_driver & if (fice(i) >= Model%min_seaice) then icy(i) = .true. else - fice(i) = zero + wet(i) = .true. + fice(i) = zero + flag_cice(i) = .false. + islmsk_cice(i) = 0 + islmsk(i) = 0 endif else if (fice(i) >= Model%min_lakeice) then icy(i) = .true. else - fice(i) = zero + wet(i) = .true. + fice(i) = zero + islmsk(i) = 0 endif endif if (fice(i) < one) then - wet(i)=.true. ! some open ocean/lake water exists - if (.not. Model%cplflx) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) - end if + wet(i) = .true. ! some open ocean/lake water exists + if (.not. Model%cplflx .or. Sfcprop%oceanfrac(i) == zero) & + Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) + endif else fice(i) = zero endif enddo else do i = 1, IM - frland(i) = zero - if (islmsk(i) == 0) then -! Sfcprop%tsfco(i) = Sfcprop%tsfc(i) - wet(i) = .true. - fice(i) = zero - elseif (islmsk(i) == 1) then + if (islmsk(i) == 1) then ! Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) dry(i) = .true. frland(i) = one fice(i) = zero else - fice(i) = Sfcprop%fice(i) - icy(i) = .true. + frland(i) = zero + if (flag_cice(i)) then + if (fice(i) > Model%min_seaice) then + icy(i) = .true. + else + wet(i) = .true. + fice(i) = zero + flag_cice(i) = .false. + islmsk_cice(i) = 0 + islmsk(i) = 0 + endif + else + if (fice(i) > Model%min_lakeice) then + icy(i) = .true. + else + wet(i) = .true. + fice(i) = zero + islmsk(i) = 0 + endif + endif if (fice(i) < one) then - wet(i) = .true. -! Sfcprop%tsfco(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) + wet(i)=.true. ! some open ocean/lake water exists + if (.not. Model%cplflx .or. Sfcprop%oceanfrac(i) == zero) & + Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) endif endif enddo @@ -1499,7 +1519,7 @@ subroutine GFS_physics_driver & do i=1,im if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg tem1 = adjsfcdsw(i) / xcosz(i) - if ( tem1 >= 120.0 ) then + if ( tem1 >= 120.0d0 ) then Diag%suntim(i) = Diag%suntim(i) + dtf endif endif @@ -1581,8 +1601,8 @@ subroutine GFS_physics_driver & kinver(i) = levs !## CCPP ## GFS_typedefs.F90/interstitial_phys_reset invrsn(i) = .false. tx1(i) = zero - tx2(i) = 10.0 - ctei_r(i) = 10.0 + tx2(i) = 10.0d0 + ctei_r(i) = 10.0d0 enddo ! Only used for old shallow convection with mstrat=.true. @@ -1592,12 +1612,12 @@ subroutine GFS_physics_driver & ctei_rml(:) = Model%ctei_rm(1)*work1(:) + Model%ctei_rm(2)*work2(:) do k=1,levs/2 do i=1,im - if (Statein%prsi(i,1)-Statein%prsi(i,k+1) < 0.35*Statein%prsi(i,1) & + if (Statein%prsi(i,1)-Statein%prsi(i,k+1) < 0.35d0*Statein%prsi(i,1) & .and. (.not. invrsn(i))) then tem = (Statein%tgrs(i,k+1) - Statein%tgrs(i,k)) & / (Statein%prsl(i,k) - Statein%prsl(i,k+1)) - if (((tem > 0.00010) .and. (tx1(i) < zero)) .or. & + if (((tem > 0.00010d0) .and. (tx1(i) < zero)) .or. & ((tem-abs(tx1(i)) > zero) .and. (tx2(i) < zero))) then invrsn(i) = .true. @@ -1611,7 +1631,7 @@ subroutine GFS_physics_driver & ctei_r(i) = (one/hocp)*tem1/(Statein%qgrs(i,k+1,1)-Statein%qgrs(i,k,1) & + Statein%qgrs(i,k+1,ntcw)-Statein%qgrs(i,k,ntcw)) else - ctei_r(i) = 10 + ctei_r(i) = 10.0d0 endif if ( ctei_rml(i) > ctei_r(i) ) then @@ -1654,7 +1674,7 @@ subroutine GFS_physics_driver & Diag%smcref2(i) = zero wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & Statein%vgrs(i,1)*Statein%vgrs(i,1)) & - + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) + + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0d0)), one) !*## CCPP ## enddo !*## CCPP ## @@ -1690,7 +1710,7 @@ subroutine GFS_physics_driver & !*## CCPP ## !## CCPP ##* GFS_surface_loop_control/GFS_surface_loop_control_part1_run do i=1,im - if (iter == 1 .and. wind(i) < 2.0) then + if (iter == 1 .and. wind(i) < 2.0d0) then flag_guess(i) = .true. endif enddo @@ -1764,8 +1784,8 @@ subroutine GFS_physics_driver & ! --- ... run nsst model ... --- if (Model%nstf_name(1) > 1) then - zsea1 = 0.001*real(Model%nstf_name(4)) - zsea2 = 0.001*real(Model%nstf_name(5)) + zsea1 = 0.001d0*real(Model%nstf_name(4)) + zsea2 = 0.001d0*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) do i=1,im @@ -1993,7 +2013,7 @@ subroutine GFS_physics_driver & flag_iter(i) = .false. flag_guess(i) = .false. - if (iter == 1 .and. wind(i) < 2.0) then + if (iter == 1 .and. wind(i) < 2.0d0) then ! if (dry(i) .or. (wet(i) .and. .not.icy(i) & if (dry(i) .or. (wet(i) .and. Model%nstf_name(1) > 0)) then flag_iter(i) = .true. @@ -2126,22 +2146,23 @@ subroutine GFS_physics_driver & Sfcprop%zorll(i) = zorl3(i,1) Sfcprop%zorlo(i) = zorl3(i,3) - if (flag_cice(i) .and. wet(i)) then ! this was already done for lake ice in sfc_sice - txi = fice(i) - txo = one - txi - evap(i) = txi * evap3(i,2) + txo * evap3(i,3) - hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) - Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) - else ! return updated lake ice thickness & concentration to global array - if (islmsk(i) == 2) then - Sfcprop%hice(i) = zice(i) - Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen - Sfcprop%tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) - Sfcprop%hice(i) = zero - Sfcprop%fice(i) = zero - Sfcprop%tisfc(i) = Sfcprop%tsfc(i) + if (flag_cice(i)) then + if (wet(i)) then ! this was already done for lake ice in sfc_sice + txi = fice(i) + txo = one - txi + evap(i) = txi * evap3(i,2) + txo * evap3(i,3) + hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) + Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) endif + elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + Sfcprop%hice(i) = zice(i) + Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen + Sfcprop%tisfc(i) = tice(i) + else ! this would be over open ocean or land (no ice fraction) + Sfcprop%hice(i) = zero + Sfcprop%fice(i) = zero + Sfcprop%tisfc(i) = Sfcprop%tsfc(i) + icy(i) = .false. endif enddo endif ! if (Model%frac_grid) @@ -2234,11 +2255,11 @@ subroutine GFS_physics_driver & if (wet(i)) then ! some open water ! --- compute open water albedo xcosz_loc = max( zero, min( one, xcosz(i) )) - ocalnirdf_cpl(i) = 0.06 - ocalnirbm_cpl(i) = max(albdf, 0.026/(xcosz_loc**1.7+0.065) & - & + 0.15 * (xcosz_loc-0.1) * (xcosz_loc-0.5) & + ocalnirdf_cpl(i) = 0.06d0 + ocalnirbm_cpl(i) = max(albdf, 0.026d0/(xcosz_loc**1.7d0+0.065d0) & + & + 0.15d0 * (xcosz_loc-0.1d0) * (xcosz_loc-0.5d0) & & * (xcosz_loc-one)) - ocalvisdf_cpl(i) = 0.06 + ocalvisdf_cpl(i) = 0.06d0 ocalvisbm_cpl(i) = ocalnirbm_cpl(i) Coupling%nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl(i)) @@ -3074,7 +3095,7 @@ subroutine GFS_physics_driver & if (ntke > 0) then tke(1:im,:) = Statein%qgrs(1:im,:,ntke) + dqdt(1:im,:,ntke) * dtp else - tke(:,:) = -9999.0 + tke(:,:) = -9999.0d0 endif ! ! tendency without PBL-accumulations @@ -3351,7 +3372,7 @@ subroutine GFS_physics_driver & do k=1,levs do i=1,im clw(i,k,1) = zero - clw(i,k,2) = -999.9 + clw(i,k,2) = -999.9d0 enddo enddo @@ -3420,7 +3441,7 @@ subroutine GFS_physics_driver & !## CCPP ## GFS_suite_interstitial.F90/GFS_suite_interstitial_3_run if (ntcw > 0) then ! if (imp_physics == Model%imp_physics_mg .and. .not. Model%do_shoc) then ! compute rhc for GMAO macro physics cloud pdf - if (imp_physics == Model%imp_physics_mg .and. Model%crtrh(2) < 0.5) then ! compute rhc for GMAO macro physics cloud pdf + if (imp_physics == Model%imp_physics_mg .and. Model%crtrh(2) < 0.5d0) then ! compute rhc for GMAO macro physics cloud pdf do i=1,im tx1(i) = one / Statein%prsi(i,1) tx2(i) = one - rhc_max*work1(i) - Model%crtrh(1)*work2(i) @@ -3879,7 +3900,7 @@ subroutine GFS_physics_driver & do k=1,levs kk = min(k+1,levs) ! assuming no cloud top reaches the model top do i=1,im !DD - sigmafrac(i,k) = 0.5 * (sigmatot(i,k)+sigmatot(i,kk)) + sigmafrac(i,k) = 0.5d0 * (sigmatot(i,k)+sigmatot(i,kk)) enddo enddo endif @@ -3905,7 +3926,7 @@ subroutine GFS_physics_driver & enddo else do i=1,im - ccwfac(i) = -999.0 + ccwfac(i) = -999.0d0 dlqfac(i) = zero psaur_l(i) = Model%psauras(1)*work1(i) + Model%psauras(2)*work2(i) praur_l(i) = Model%prauras(1)*work1(i) + Model%prauras(2)*work2(i) @@ -3925,8 +3946,8 @@ subroutine GFS_physics_driver & revap = .true. ! if (ncld ==2) revap = .false. - trcmin(:) = -999999.0 - if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4 + trcmin(:) = -999999.0d0 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 !*## CCPP ## ! if (lprnt) write(0,*)' gt04bras=',Stateout%gt0(ipr,:) ! if (lprnt) write(0,*)' gq04bras=',Stateout%gq0(ipr,:,1) @@ -4237,10 +4258,10 @@ subroutine GFS_physics_driver & do k=1,levs do i=1,im - eng0 = 0.5*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + eng0 = 0.5d0*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) Stateout%gu0(i,k) = Stateout%gu0(i,k) + gwdcu(i,k) * dtp Stateout%gv0(i,k) = Stateout%gv0(i,k) + gwdcv(i,k) * dtp - eng1 = 0.5*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + eng1 = 0.5d0*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) Stateout%gt0(i,k) = Stateout%gt0(i,k) + (eng0-eng1)/(dtp*con_cp) enddo ! if (lprnt) write(7000,*)' gu0=',gu0(ipr,k),' gwdcu=', @@ -4385,7 +4406,7 @@ subroutine GFS_physics_driver & levshc(:) = 0 do k=2,levs do i=1,im - dpshc = 0.3 * Statein%prsi(i,1) + dpshc = 0.3d0 * Statein%prsi(i,1) if (Statein%prsi(i,1)-Statein%prsi(i,k) <= dpshc) levshc(i) = k enddo enddo @@ -4436,7 +4457,7 @@ subroutine GFS_physics_driver & ! do k=1,levs do i=1,im - if (clw(i,k,2) <= -999.0) clw(i,k,2) = zero + if (clw(i,k,2) <= -999.0d0) clw(i,k,2) = zero enddo enddo !*## CCPP ## @@ -5172,8 +5193,8 @@ subroutine GFS_physics_driver & 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)) + den(i,k) = 0.622d0*Statein%prsl(i,k) / & + (con_rd*Stateout%gt0(i,k)*(Stateout%gq0(i,k,1)+0.622d0)) enddo endif enddo @@ -5188,8 +5209,8 @@ subroutine GFS_physics_driver & 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. + Diag%refdmax(I) = -35.0d0 + Diag%refdmax263k(I) = -35.0d0 enddo endif do i=1,im @@ -5355,33 +5376,6 @@ subroutine GFS_physics_driver & endif - if (Model%lssav) then -! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & -! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & -! 'rain=',Diag%rain(1) - do i=1,im - Diag%cnvprcp(i) = Diag%cnvprcp(i) + Diag%rainc(i) - Diag%totprcp (i) = Diag%totprcp (i) + Diag%rain(i) - Diag%totice (i) = Diag%totice (i) + Diag%ice(i) - Diag%totsnw (i) = Diag%totsnw (i) + Diag%snow(i) - Diag%totgrp (i) = Diag%totgrp (i) + Diag%graupel(i) -! - Diag%cnvprcpb(i) = Diag%cnvprcpb(i) + Diag%rainc(i) - Diag%totprcpb(i) = Diag%totprcpb(i) + Diag%rain(i) - Diag%toticeb (i) = Diag%toticeb (i) + Diag%ice(i) - Diag%totsnwb (i) = Diag%totsnwb (i) + Diag%snow(i) - Diag%totgrpb (i) = Diag%totgrpb (i) + Diag%graupel(i) - enddo - - if (Model%ldiag3d) then - do k=1,levs - do i=1,im - Diag%dt3dt(i,k,6) = Diag%dt3dt(i,k,6) + (Stateout%gt0(i,k)-dtdt(i,k)) * frain -! Diag%dq3dt(i,k,4) = Diag%dq3dt(i,k,4) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain - enddo - enddo - endif - endif !*## CCPP ## !## CCPP ##* this block not yet in CCPP !-------------------------------- @@ -5446,14 +5440,21 @@ 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 - Sfcprop%srflag(i) = max(zero, min(one, (Diag%rain(i)-Diag%rainc(i))*Diag%sr(i)/Diag%rain(i))) + if (Diag%rain(i) > rainmin) then + tem1 = max(zero, (Diag%rain(i)-Diag%rainc(i))) * Diag%sr(i) + tem2 = one / Diag%rain(i) + if (t850(i) > 273.16d0) then + Sfcprop%srflag(i) = max(zero, min(one, tem1*tem2)) + else + Sfcprop%srflag(i) = max(zero, min(one, (tem1+Diag%rainc(i))*tem2)) + endif else Sfcprop%srflag(i) = zero + Diag%rain(i) = zero + Diag%rainc(i) = zero endif + Sfcprop%tprcp(i) = max(zero, Diag%rain(i) ) ! clu: rain -> tprcp enddo else do i = 1, im @@ -5466,13 +5467,40 @@ subroutine GFS_physics_driver & endif endif + if (Model%lssav) then +! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & +! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & +! 'rain=',Diag%rain(1) + do i=1,im + Diag%cnvprcp(i) = Diag%cnvprcp(i) + Diag%rainc(i) + Diag%totprcp (i) = Diag%totprcp (i) + Diag%rain(i) + Diag%totice (i) = Diag%totice (i) + Diag%ice(i) + Diag%totsnw (i) = Diag%totsnw (i) + Diag%snow(i) + Diag%totgrp (i) = Diag%totgrp (i) + Diag%graupel(i) +! + Diag%cnvprcpb(i) = Diag%cnvprcpb(i) + Diag%rainc(i) + Diag%totprcpb(i) = Diag%totprcpb(i) + Diag%rain(i) + Diag%toticeb (i) = Diag%toticeb (i) + Diag%ice(i) + Diag%totsnwb (i) = Diag%totsnwb (i) + Diag%snow(i) + Diag%totgrpb (i) = Diag%totgrpb (i) + Diag%graupel(i) + enddo + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,6) = Diag%dt3dt(i,k,6) + (Stateout%gt0(i,k)-dtdt(i,k)) * frain +! Diag%dq3dt(i,k,4) = Diag%dq3dt(i,k,4) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + enddo + enddo + endif + endif ! --- ... coupling insertion if (Model%cplflx .or. Model%cplchm) then do i = 1, im - Tbd%dsnow_cpl(i)= Diag%rain(i) * Sfcprop%srflag(i) - Tbd%drain_cpl(i)= Diag%rain(i) - Tbd%dsnow_cpl(i) + Tbd%dsnow_cpl(i)= max(zero, Diag%rain(i) * Sfcprop%srflag(i)) + Tbd%drain_cpl(i)= max(zero, Diag%rain(i) - Tbd%dsnow_cpl(i)) Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Tbd%drain_cpl(i) Coupling%snow_cpl(i) = Coupling%snow_cpl(i) + Tbd%dsnow_cpl(i) enddo @@ -5644,7 +5672,7 @@ subroutine GFS_physics_driver & Diag%u10max(i) = Diag%u10m(i) Diag%v10max(i) = Diag%v10m(i) endif - pshltr = Statein%pgr(i)*exp(-0.068283/Stateout%gt0(i,1)) + pshltr = Statein%pgr(i)*exp(-0.068283d0/Stateout%gt0(i,1)) QCQ = PQ0/pshltr*EXP(A2A*(Sfcprop%t2m(i)-A3)/(Sfcprop%t2m(i)-A4)) rh02 = Sfcprop%q2m(i) / QCQ IF (rh02 > one) THEN diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index d9190c3b3..4fd9c18cd 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -377,11 +377,11 @@ module module_radiation_driver ! !> EPSQ=1.0e-12 real (kind=kind_phys) :: EPSQ ! parameter (QMIN=1.0e-10, QME5=1.0e-5, QME6=1.0e-6, EPSQ=1.0e-12) - parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) + parameter (QMIN=1.0d-10, QME5=1.0d-7, QME6=1.0d-7, EPSQ=1.0d-12) ! parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12) !> lower limit of toa pressure value in mb - real, parameter :: prsmin = 1.0e-6 + real, parameter :: prsmin = 1.0d-6 !> control flag for LW surface temperature at air/ground interface !! (default=0, the value will be set in subroutine radinit) @@ -1247,6 +1247,8 @@ subroutine GFS_radiation_driver & real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+ltp) :: cldtausw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+ltp) :: cldtaulw + real(kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 + !--- TYPED VARIABLES type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw @@ -1340,15 +1342,15 @@ subroutine GFS_radiation_driver & k1 = k + kd k2 = k + lsk do i = 1, IM - plvl(i,k1+kb) = Statein%prsi(i,k2+kb) * 0.01 ! pa to mb (hpa) - plyr(i,k1) = Statein%prsl(i,k2) * 0.01 ! pa to mb (hpa) + plvl(i,k1+kb) = Statein%prsi(i,k2+kb) * 0.01d0 ! pa to mb (hpa) + plyr(i,k1) = Statein%prsl(i,k2) * 0.01d0 ! pa to mb (hpa) tlyr(i,k1) = Statein%tgrs(i,k2) prslk1(i,k1) = Statein%prslk(i,k2) !> - Compute relative humidity. es = min( Statein%prsl(i,k2), fpvs( Statein%tgrs(i,k2) ) ) ! fpvs and prsl in pa qs = max( QMIN, eps * es / (Statein%prsl(i,k2) + epsm1*es) ) - rhly(i,k1) = max( 0.0, min( 1.0, max(QMIN, Statein%qgrs(i,k2,1))/qs ) ) + rhly(i,k1) = max( zero, min( one, max(QMIN, Statein%qgrs(i,k2,1))/qs ) ) qstl(i,k1) = qs enddo enddo @@ -1358,7 +1360,7 @@ subroutine GFS_radiation_driver & do k = 1, LM k1 = k + kd k2 = k + lsk - tracer1(:,k1,j) = max(0.0, Statein%qgrs(:,k2,j)) + tracer1(:,k1,j) = max(zero, Statein%qgrs(:,k2,j)) enddo enddo ! @@ -1367,18 +1369,18 @@ subroutine GFS_radiation_driver & k1 = 1 + kd k2 = k1 + kb do i = 1, IM - plvl(i,k2) = 0.01 * Statein%prsi(i,1+kb) ! pa to mb (hpa) - plyr(i,k1) = 0.5 * (plvl(i,k2+1) + plvl(i,k2)) - prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp + plvl(i,k2) = 0.01d0 * Statein%prsi(i,1+kb) ! pa to mb (hpa) + plyr(i,k1) = 0.5d0 * (plvl(i,k2+1) + plvl(i,k2)) + prslk1(i,k1) = (plyr(i,k1)*0.001d0) ** rocp enddo endif else ! input data from sfc to top if (Model%levs > lm) then k1 = lm + kd do i = 1, IM - plvl(i,k1+1) = 0.01 * Statein%prsi(i,Model%levs+1) ! pa to mb (hpa) - plyr(i,k1) = 0.5 * (plvl(i,k1+1) + plvl(i,k1)) - prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp + plvl(i,k1+1) = 0.01d0 * Statein%prsi(i,Model%levs+1) ! pa to mb (hpa) + plyr(i,k1) = 0.5d0 * (plvl(i,k1+1) + plvl(i,k1)) + prslk1(i,k1) = (plyr(i,k1)*0.001d0) ** rocp enddo endif endif @@ -1386,10 +1388,10 @@ subroutine GFS_radiation_driver & if ( lextop ) then ! values for extra top layer do i = 1, IM plvl(i,llb) = prsmin - if ( plvl(i,lla) <= prsmin ) plvl(i,lla) = 2.0*prsmin - plyr(i,lyb) = 0.5 * plvl(i,lla) + if ( plvl(i,lla) <= prsmin ) plvl(i,lla) = 2.0d0*prsmin + plyr(i,lyb) = 0.5d0 * plvl(i,lla) tlyr(i,lyb) = tlyr(i,lya) - prslk1(i,lyb) = (plyr(i,lyb)*0.001) ** rocp ! plyr in Pa + prslk1(i,lyb) = (plyr(i,lyb)*0.001d0) ** rocp ! plyr in Pa rhly(i,lyb) = rhly(i,lya) qstl(i,lyb) = qstl(i,lya) enddo @@ -1461,7 +1463,7 @@ subroutine GFS_radiation_driver & do i = 1, IM qlyr(i,k1) = max( tem1d(i), Statein%qgrs(i,k,1) ) tem1d(i) = min( QME5, qlyr(i,k1) ) - tvly(i,k1) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k1)) ! virtual T (K) + tvly(i,k1) = Statein%tgrs(i,k) * (one + fvirt*qlyr(i,k1)) ! virtual T (K) delp(i,k1) = plvl(i,k1+1) - plvl(i,k1) enddo enddo @@ -1484,7 +1486,7 @@ subroutine GFS_radiation_driver & ! --- ... level height and layer thickness (km) - tem0d = 0.001 * rog + tem0d = 0.001d0 * rog do i = 1, IM do k = 1, LMK dz(i,k) = tem0d * (tem2db(i,k+1) - tem2db(i,k)) * tvly(i,k) @@ -1512,7 +1514,7 @@ subroutine GFS_radiation_driver & do i = 1, IM qlyr(i,k) = max( tem1d(i), Statein%qgrs(i,k,1) ) tem1d(i) = min( QME5, qlyr(i,k) ) - tvly(i,k) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k)) ! virtual T (K) + tvly(i,k) = Statein%tgrs(i,k) * (one + fvirt*qlyr(i,k)) ! virtual T (K) delp(i,k) = plvl(i,k) - plvl(i,k+1) enddo enddo @@ -1535,7 +1537,7 @@ subroutine GFS_radiation_driver & ! --- ... level height and layer thickness (km) - tem0d = 0.001 * rog + tem0d = 0.001d0 * rog do i = 1, IM do k = LMK, 1, -1 dz(i,k) = tem0d * (tem2db(i,k) - tem2db(i,k+1)) * tvly(i,k) @@ -1553,7 +1555,7 @@ subroutine GFS_radiation_driver & !## CCPP ##* rrtmg_sw_pre.F90/rrtmg_sw_pre_run nday = 0 do i = 1, IM - if (Radtend%coszen(i) >= 0.0001) then + if (Radtend%coszen(i) >= 0.0001d0) then nday = nday + 1 idxday(nday) = i endif @@ -1582,7 +1584,7 @@ subroutine GFS_radiation_driver & ! --- ... obtain cloud information for radiation calculations ! if (ntcw > 0) then ! prognostic cloud schemes - ccnd = 0.0_kind_phys + ccnd = zero if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist do k=1,LMK do i=1,IM @@ -1618,7 +1620,7 @@ subroutine GFS_radiation_driver & do n=1,ncndl do k=1,LMK do i=1,IM - if (ccnd(i,k,n) < epsq) ccnd(i,k,n) = 0.0 + if (ccnd(i,k,n) < epsq) ccnd(i,k,n) = zero enddo enddo enddo @@ -1646,7 +1648,7 @@ subroutine GFS_radiation_driver & endif do k=1,LMK do i=1,IM - if (ccnd(i,k,1) < EPSQ ) ccnd(i,k,1) = 0.0 + if (ccnd(i,k,1) < EPSQ ) ccnd(i,k,1) = zero enddo enddo endif @@ -1696,7 +1698,7 @@ subroutine GFS_radiation_driver & endif else ! neither of the other two cases - cldcov = 0.0 + cldcov = zero endif ! @@ -1719,17 +1721,17 @@ subroutine GFS_radiation_driver & do k=1,lm k1 = k + kd do i=1,im - deltaq(i,k1) = 0.0 + deltaq(i,k1) = zero cnvw (i,k1) = Tbd%phy_f3d(i,k,Model%num_p3d+1) - cnvc (i,k1) = 0.0 + cnvc (i,k1) = zero enddo enddo else ! all the rest do k=1,lmk do i=1,im - deltaq(i,k) = 0.0 - cnvw (i,k) = 0.0 - cnvc (i,k) = 0.0 + deltaq(i,k) = zero + cnvw (i,k) = zero + cnvc (i,k) = zero enddo enddo endif @@ -1811,9 +1813,9 @@ subroutine GFS_radiation_driver & elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then ! Thompson / WSM6 cloud micrphysics scheme if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,1) = 10. - Tbd%phy_f3d(:,:,2) = 50. - Tbd%phy_f3d(:,:,3) = 250. + Tbd%phy_f3d(:,:,1) = 10.0d0 + Tbd%phy_f3d(:,:,2) = 50.0d0 + Tbd%phy_f3d(:,:,3) = 250.0d0 endif call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs @@ -1838,9 +1840,9 @@ subroutine GFS_radiation_driver & ! --- scale random patterns for surface perturbations with ! perturbation size ! --- turn vegetation fraction pattern into percentile pattern - alb1d(:) = 0. + alb1d(:) = zero if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + if (Model%pertalb(1) > zero) then do i=1,im call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) enddo @@ -1866,7 +1868,7 @@ subroutine GFS_radiation_driver & sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + Radtend%sfalb(:) = max(0.01d0, 0.5d0 * (sfcalb(:,2) + sfcalb(:,4))) !*## CCPP ## !## CCPP ##* radsw_main.f/rrtmg_sw_run; Note: The checks for nday and lsswr are included in the scheme (returns if @@ -1942,26 +1944,26 @@ subroutine GFS_radiation_driver & else ! if_nday_block - Radtend%htrsw(:,:) = 0.0 + Radtend%htrsw(:,:) = zero Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) do i=1,im - Coupling%nirbmdi(i) = 0.0 - Coupling%nirdfdi(i) = 0.0 - Coupling%visbmdi(i) = 0.0 - Coupling%visdfdi(i) = 0.0 - - Coupling%nirbmui(i) = 0.0 - Coupling%nirdfui(i) = 0.0 - Coupling%visbmui(i) = 0.0 - Coupling%visdfui(i) = 0.0 + Coupling%nirbmdi(i) = zero + Coupling%nirdfdi(i) = zero + Coupling%visbmdi(i) = zero + Coupling%visdfdi(i) = zero + + Coupling%nirbmui(i) = zero + Coupling%nirdfui(i) = zero + Coupling%visbmui(i) = zero + Coupling%visdfui(i) = zero enddo if (Model%swhtr) then - Radtend%swhc(:,:) = 0.0 + Radtend%swhc(:,:) = zero endif endif ! end_if_nday @@ -2084,7 +2086,7 @@ subroutine GFS_radiation_driver & ! part of sw calling interval, while coszdg= mean cosz over entire interval if (Model%lsswr) then do i = 1, IM - if (Radtend%coszen(i) > 0.) then + if (Radtend%coszen(i) > zero) then ! --- sw total-sky fluxes ! ------------------- tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) @@ -2144,7 +2146,7 @@ subroutine GFS_radiation_driver & tem0d = raddt * cldsa(i,j) itop = mtopa(i,j) - kd ibtc = mbota(i,j) - kd - tem1 = 0. + tem1 = zero do k=ibtc,itop tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel enddo @@ -2159,11 +2161,11 @@ subroutine GFS_radiation_driver & tem0d = raddt * cldsa(i,j) itop = mtopa(i,j) - kd ibtc = mbota(i,j) - kd - tem2 = 0. + tem2 = zero do k=ibtc,itop tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel enddo - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (one-exp(-tem2)) enddo enddo endif diff --git a/gfsphysics/physics/gcm_shoc.f90 b/gfsphysics/physics/gcm_shoc.f90 index f5791a049..fa6133899 100644 --- a/gfsphysics/physics/gcm_shoc.f90 +++ b/gfsphysics/physics/gcm_shoc.f90 @@ -484,7 +484,7 @@ subroutine tke_shoc() call eddy_length() ! Find turbulent mixing length call check_eddy() ! Make sure it's reasonable - tkef2 = 1.0 - tkef1 + tkef2 = one - tkef1 do k=1,nzm ku = k+1 kd = k @@ -528,7 +528,7 @@ subroutine tke_shoc() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001d0) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) @@ -732,7 +732,7 @@ subroutine eddy_length() ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,k) / (wrk+1.e-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.0d-20) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp @@ -877,7 +877,7 @@ subroutine eddy_length() enddo conv_var = conv_var ** oneb3 - if (conv_var > 0) then ! If convective vertical velocity scale > 0 + if (conv_var > zero) then ! If convective vertical velocity scale > 0 depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) @@ -937,7 +937,7 @@ subroutine conv_scale() !********************************************************************** conv_vel2(i,k) = conv_vel2(i,k-1) & - + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) + + 2.5d0*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -976,7 +976,7 @@ subroutine check_eddy() ! 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 (qcl(i,kb) == zero .and. qcl(i,k) > zero .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 smixt(i,k) = wrk endif @@ -1096,7 +1096,7 @@ subroutine canuto() omega0 = a4 / (one-a5*buoy_sgs2) omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5./4.)*omega0*f4 + omega2 = omega1*f3+(5.0d0/4.0d0)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) @@ -1119,7 +1119,7 @@ subroutine canuto() !aab ! Implemetation of the C01 approach in this subroutine is nearly complete @@ -1256,14 +1256,14 @@ subroutine assumed_pdf() Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi ! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4 - w2_2 = 0.4 + w2_1 = 0.4d0 + w2_2 = 0.4d0 ! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.0d0*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) onema = one - aterm sqrtw2t = sqrt(wrk) @@ -1347,12 +1347,12 @@ subroutine assumed_pdf() ! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4) THEN + IF (tsign > 0.4d0) THEN Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2) THEN + ELSEIF (tsign <= 0.2d0) THEN Skew_qw = zero ELSE - Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) + Skew_qw = (skew_facw/0.2d0) * Skew_w * (tsign-0.2d0) ENDIF wrk1 = qw1_1 * qw1_1 @@ -1386,7 +1386,7 @@ subroutine assumed_pdf() testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 - IF (testvar == 0) THEN + IF (testvar == zero) THEN r_qwthl_1 = zero ELSE r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & @@ -1560,7 +1560,7 @@ subroutine assumed_pdf() diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) - diag_qi = diag_qn - diag_ql + diag_qi = max(zero, diag_qn - diag_ql) ! Update temperature variable based on diagnosed cloud properties @@ -1579,11 +1579,6 @@ subroutine assumed_pdf() ! Update ncpl and ncpi Anning Cheng 03/11/2016 ! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) - qc(i,k) = diag_ql - qi(i,k) = diag_qi - qwv(i,k) = total_water(i,k) - diag_qn - cld_sgs(i,k) = diag_frac - ! Update ncpl and ncpi Moorthi 12/12/2018 if (imp_phys > 0) then if (ncpl(i,k) > nmin) then @@ -1598,6 +1593,10 @@ subroutine assumed_pdf() endif endif + qc(i,k) = diag_ql + qi(i,k) = diag_qi + qwv(i,k) = max(zero, total_water(i,k) - diag_qn) + cld_sgs(i,k) = diag_frac ! Compute the liquid water flux wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) diff --git a/gfsphysics/physics/get_prs.f b/gfsphysics/physics/get_prs.f index 5994d0e63..9ce05c904 100644 --- a/gfsphysics/physics/get_prs.f +++ b/gfsphysics/physics/get_prs.f @@ -22,8 +22,10 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, &, q(ix,levs,ntrac) real(kind=kind_phys) xcp(ix,levs), xr(ix,levs), kappa(ix,levs) real(kind=kind_phys) tem, dphib, dphit, dphi - real (kind=kind_phys), parameter :: zero=0.0, p00i=1.0e-5 - &, rkapi=1.0/rkap, rkapp1=1.0+rkap + real (kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 + &, half=0.5d0, p00i=1.0d-5 + &, rkapi=one/rkap + &, rkapp1=one+rkap integer i, k, n ! do k=1,levs @@ -33,7 +35,7 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, enddo ! if( gen_coord_hybrid ) then ! hmhj - if( thermodyn_id.eq.3 ) then ! Enthalpy case + if( thermodyn_id == 3 ) then ! Enthalpy case ! ! hmhj : This is for generalized hybrid (Henry) with finite difference ! in the vertical and enthalpy as the prognostic (thermodynamic) @@ -47,13 +49,13 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, do k=1,levs do i=1,im kappa(i,k) = xr(i,k)/xcp(i,k) - prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*0.5 + prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*half prkl(i,k) = (prsl(i,k)*p00i) ** kappa(i,k) enddo enddo do k=2,levs do i=1,im - tem = 0.5 * (kappa(i,k) + kappa(i,k-1)) + tem = half * (kappa(i,k) + kappa(i,k-1)) prki(i,k-1) = (prsi(i,k)*p00i) ** tem enddo enddo @@ -61,14 +63,14 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, prki(i,1) = (prsi(i,1)*p00i) ** kappa(i,1) enddo k = levs + 1 - if (prsi(1,k) .gt. 0.0) then + if (prsi(1,k) > zero) then do i=1,im prki(i,k) = (prsi(i,k)*p00i) ** kappa(i,levs) enddo endif ! do i=1,im - phii(i,1) = 0.0 ! Ignoring topography height here + phii(i,1) = zero ! Ignoring topography height here enddo DO k=1,levs do i=1,im @@ -82,16 +84,16 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, ENDDO ENDDO endif - if (prsl(1,1) <= 0.0) then + if (prsl(1,1) <= zero) then do k=1,levs do i=1,im - prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*0.5 + prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*half enddo enddo endif - if (phil(1,levs) <= 0.0) then ! If geopotential is not given, calculate + if (phil(1,levs) <= zero) then ! If geopotential is not given, calculate do i=1,im - phii(i,1) = 0.0 ! Ignoring topography height here + phii(i,1) = zero ! Ignoring topography height here enddo call GET_R(im,ix,levs,ntrac,q,xr) DO k=1,levs @@ -110,44 +112,44 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, if (prki(1,1) <= zero .or. prkl(1,1) <= zero) then do k=1,levs do i=1,im - prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*0.5 + prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*half prkl(i,k) = (prsl(i,k)*p00i) ** rkap - enddo - enddo - do k=1,levs+1 - do i=1,im - prki(i,k) = (prsi(i,k)*p00i) ** rkap - enddo enddo + enddo + do k=1,levs+1 do i=1,im - phii(i,1) = 0.0 ! Ignoring topography height here + prki(i,k) = (prsi(i,k)*p00i) ** rkap enddo - DO k=1,levs - do i=1,im - TEM = rd * T(i,k)*(1.0+NU*max(Q(i,k,1),zero)) - DPHI = (PRSI(i,k) - PRSI(i,k+1)) * TEM - & / (PRSI(i,k) + PRSI(i,k+1)) - phil(i,k) = phii(i,k) + DPHI - phii(i,k+1) = phil(i,k) + DPHI + enddo + do i=1,im + phii(i,1) = zero ! Ignoring topography height here + enddo + DO k=1,levs + do i=1,im + TEM = rd * T(i,k) * (one+NU*max(Q(i,k,1),zero)) + DPHI = (PRSI(i,k) - PRSI(i,k+1)) * TEM + & / (PRSI(i,k) + PRSI(i,k+1)) + phil(i,k) = phii(i,k) + DPHI + phii(i,k+1) = phil(i,k) + DPHI ! if (k == 1 .and. phil(i,k) < 0.0) write(0,*)' phil=',phil(i,k) ! &,' dphi=',dphi,' prsi=',prsi(i,k),prsi(i,k+1),' tem=',tem - ENDDO ENDDO + ENDDO endif - if (prsl(1,1) <= 0.0) then + if (prsl(1,1) <= zero) then do k=1,levs do i=1,im - prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*0.5 + prsl(i,k) = (PRSI(i,k) + PRSI(i,k+1))*half enddo enddo endif - if (phil(1,levs) <= 0.0) then ! If geopotential is not given, calculate + if (phil(1,levs) <= zero) then ! If geopotential is not given, calculate do i=1,im - phii(i,1) = 0.0 ! Ignoring topography height here + phii(i,1) = zero ! Ignoring topography height here enddo DO k=1,levs do i=1,im - TEM = rd * T(i,k)*(1.0+NU*max(Q(i,k,1),zero)) + TEM = rd * T(i,k)*(one+NU*max(Q(i,k,1),zero)) DPHI = (PRSI(i,k) - PRSI(i,k+1)) * TEM & / (PRSI(i,k) + PRSI(i,k+1)) phil(i,k) = phii(i,k) + DPHI @@ -183,20 +185,20 @@ subroutine GET_PRS(im,ix,levs,ntrac,t,q, enddo enddo endif - if (prsl(1,1) <= 0.0) then + if (prsl(1,1) <= zero) then do k=1,levs do i=1,im - PRSL(i,k) = 100.0 * PRKL(i,k) ** rkapi + PRSL(i,k) = 100.0d0 * PRKL(i,k) ** rkapi enddo enddo endif - if (phil(1,levs) <= 0.0) then ! If geopotential is not given, calculate + if (phil(1,levs) <= zero) then ! If geopotential is not given, calculate do i=1,im - phii(i,1) = 0.0 ! Ignoring topography height here + phii(i,1) = zero ! Ignoring topography height here enddo DO k=1,levs do i=1,im - TEM = CP * T(i,k) * (1.0 + NU*max(Q(i,k,1),zero)) + TEM = CP * T(i,k) * (one + NU*max(Q(i,k,1),zero)) & / PRKL(i,k) DPHIB = (PRKI(i,k) - PRKL(i,k)) * TEM DPHIT = (PRKL(i,k ) - PRKI(i,k+1)) * TEM @@ -232,14 +234,14 @@ subroutine GET_PHI(im,ix,levs,ntrac,t,q, &, T(ix,levs), q(ix,levs,ntrac) real(kind=kind_phys) xr(ix,levs) real(kind=kind_phys) tem, dphib, dphit, dphi - real (kind=kind_phys), parameter :: zero=0.0 + real (kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 integer i, k, n ! do i=1,im phii(i,1) = zero ! Ignoring topography height here enddo if( gen_coord_hybrid ) then ! hmhj - if( thermodyn_id.eq.3 ) then ! Enthalpy case + if( thermodyn_id == 3 ) then ! Enthalpy case call GET_R(im,ix,levs,ntrac,q,xr) DO k=1,levs do i=1,im @@ -256,7 +258,7 @@ subroutine GET_PHI(im,ix,levs,ntrac,t,q, else ! gc Virtual Temp DO k=1,levs do i=1,im - TEM = RD * T(i,k) * (1.0 + NU*max(Q(i,k,1),zero)) + TEM = RD * T(i,k) * (one + NU*max(Q(i,k,1),zero)) DPHI = (PRSI(i,k) - PRSI(i,k+1)) * TEM & /(PRSI(i,k) + PRSI(i,k+1)) phil(i,k) = phii(i,k) + DPHI @@ -267,7 +269,7 @@ subroutine GET_PHI(im,ix,levs,ntrac,t,q, else ! Not gc Virt Temp (Orig Joe) DO k=1,levs do i=1,im - TEM = CP * T(i,k) * (1.0 + NU*max(Q(i,k,1),zero)) + TEM = CP * T(i,k) * (one + NU*max(Q(i,k,1),zero)) & / PRKL(i,k) DPHIB = (PRKI(i,k) - PRKL(i,k)) * TEM DPHIT = (PRKL(i,k ) - PRKI(i,k+1)) * TEM @@ -285,7 +287,7 @@ subroutine GET_CPR(im,ix,levs,ntrac,q,xcp,xr) USE tracer_const implicit none ! - real (kind=kind_phys), parameter :: zero=0.0 + real (kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 integer im, ix, levs, ntrac real(kind=kind_phys) q(ix,levs,ntrac) real(kind=kind_phys) xcp(ix,levs),xr(ix,levs),sumq(ix,levs) @@ -307,8 +309,8 @@ subroutine GET_CPR(im,ix,levs,ntrac,q,xcp,xr) enddo do k=1,levs do i=1,im - xr(i,k) = (1.-sumq(i,k))*ri(0) + xr(i,k) - xcp(i,k) = (1.-sumq(i,k))*cpi(0) + xcp(i,k) + xr(i,k) = (one-sumq(i,k))*ri(0) + xr(i,k) + xcp(i,k) = (one-sumq(i,k))*cpi(0) + xcp(i,k) enddo enddo ! @@ -320,7 +322,7 @@ subroutine GET_R(im,ix,levs,ntrac,q,xr) USE tracer_const implicit none ! - real (kind=kind_phys), parameter :: zero=0.0 + real (kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 integer im, ix, levs, ntrac real(kind=kind_phys) q(ix,levs,ntrac) real(kind=kind_phys) xr(ix,levs),sumq(ix,levs) @@ -329,7 +331,7 @@ subroutine GET_R(im,ix,levs,ntrac,q,xr) sumq = zero xr = zero do n=1,ntrac - if( ri(n) > 0.0 ) then + if( ri(n) > zero ) then do k=1,levs do i=1,im xr(i,k) = xr(i,k) + q(i,k,n) * ri(n) @@ -340,7 +342,7 @@ subroutine GET_R(im,ix,levs,ntrac,q,xr) enddo do k=1,levs do i=1,im - xr(i,k) = (1.-sumq(i,k))*ri(0) + xr(i,k) + xr(i,k) = (one-sumq(i,k))*ri(0) + xr(i,k) enddo enddo ! @@ -352,7 +354,7 @@ subroutine GET_CP(im,ix,levs,ntrac,q,xcp) USE tracer_const implicit none ! - real (kind=kind_phys), parameter :: zero=0.0 + real (kind=kind_phys), parameter :: zero=0.0d0, one=1.0d0 integer im, ix, levs, ntrac real(kind=kind_phys) q(ix,levs,ntrac) real(kind=kind_phys) xcp(ix,levs),sumq(ix,levs) @@ -361,7 +363,7 @@ subroutine GET_CP(im,ix,levs,ntrac,q,xcp) sumq = zero xcp = zero do n=1,ntrac - if( cpi(n) > 0.0 ) then + if( cpi(n) > zero ) then do k=1,levs do i=1,im xcp(i,k) = xcp(i,k) + q(i,k,n) * cpi(n) @@ -372,7 +374,7 @@ subroutine GET_CP(im,ix,levs,ntrac,q,xcp) enddo do k=1,levs do i=1,im - xcp(i,k) = (1.-sumq(i,k))*cpi(0) + xcp(i,k) + xcp(i,k) = (one-sumq(i,k))*cpi(0) + xcp(i,k) enddo enddo ! diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 26a04d96a..07979a810 100644 --- a/gfsphysics/physics/m_micro_driver.F90 +++ b/gfsphysics/physics/m_micro_driver.F90 @@ -52,11 +52,12 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & !------------------------------------ ! input ! real, parameter :: r_air = 3.47d-3 - real, parameter :: one=1.0, oneb3=one/3.0, onebcp=one/cp, & + real, parameter :: one=1.0d0, oneb3=one/3.0d0, onebcp=one/cp, & + zero=0.0d0, half=0.5d0, onebg=one/grav, & & kapa=rgas*onebcp, cpbg=cp/grav, & & lvbcp=hvap*onebcp, lsbcp=(hvap+hfus)*onebcp,& - & qsmall=1.e-14, rainmin = 1.0e-13, & - & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 + & qsmall=1.0d-14, rainmin = 1.0d-13, & + & fourb3=4.0d0/3.0d0, RL_cub=1.0d-15, nmin=1.0d0 integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag @@ -217,27 +218,28 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! real (kind=kind_phys), parameter :: disp_liu=2., ui_scale=1.0 & ! &, dcrit=20.0e-6 & - real (kind=kind_phys), parameter :: disp_liu=1.0, ui_scale=1.0 & - &, dcrit=1.0e-6 & + real (kind=kind_phys), parameter :: disp_liu=1.0d0 & + &, ui_scale=1.0d0 & + &, dcrit=1.0d-6 & ! &, ts_autice=1800.0 & ! &, ts_autice=3600.0 & !time scale - &, ninstr8 = 0.1e6 & - &, ncnstr8 = 100.0e6 + &, ninstr8 = 0.1d6 & + &, ncnstr8 = 100.0d6 real(kind=kind_phys):: k_gw, maxkh, tausurf_gw, overscale, tx1, rh1_r8 real(kind=kind_phys):: t_ice_denom - integer, dimension(1) :: lev_sed_strt ! sedimentation start level - real(kind=kind_phys), parameter :: sig_sed_strt=0.05 ! normalized pressure at sedimentation start + integer, dimension(1) :: lev_sed_strt ! sedimentation start level + real(kind=kind_phys), parameter :: sig_sed_strt=0.05d0 ! normalized pressure at sedimentation start real(kind=kind_phys),dimension(3) :: ccn_diag real(kind=kind_phys),dimension(58) :: cloudparams integer, parameter :: CCN_PARAM=2, IN_PARAM=5 - real(kind=kind_phys), parameter ::fdust_drop=1.0, fsoot_drop=0.1 & - &, sigma_nuc_r8=0.28,SCLMFDFR=0.03 -! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1 + real(kind=kind_phys), parameter ::fdust_drop=1.0d0, fsoot_drop=0.1d0 & + &, sigma_nuc_r8=0.28d0,SCLMFDFR=0.03d0 +! &, sigma_nuc_r8=0.28,SCLMFDFR=0.1d0 type (AerProps), dimension (IM,LM) :: AeroProps type (AerProps) :: AeroAux, AeroAux_b @@ -294,9 +296,9 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & CNV_UPDF(i,k) = cf_upi(i,ll) CNV_DQLDT(I,K) = CNV_DQLDT_i(I,ll) CLCN(I,k) = CLCN_i(I,ll) - CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),0.0) - PLO(i,k) = prsl_i(i,ll)*0.01 - zlo(i,k) = phil(i,ll) * (1.0/grav) + CLLS(I,k) = max(CLLS_io(I,ll)-CLCN_i(I,ll),zero) + PLO(i,k) = prsl_i(i,ll)*0.01d0 + zlo(i,k) = phil(i,ll) * onebg temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) rhc(i,k) = rhc_i(i,ll) @@ -310,8 +312,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) *.01 ! interface pressure in hPa - zet(i,k+1) = phii(i,ll) * (1.0/grav) + PLE(i,k) = prsi_i(i,ll) *0.01d0 ! interface pressure in hPa + zet(i,k+1) = phii(i,ll) * onebg END DO END DO if (.not. skip_macro) then @@ -339,7 +341,6 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & omega(i,k) = omega_i(i,k) ncpl(i,k) = ncpl_io(i,k) ncpi(i,k) = ncpi_io(i,k) - ncpi(i,k) = ncpi_io(i,k) rnw(i,k) = rnw_io(i,k) snw(i,k) = snw_io(i,k) qgl(i,k) = qgl_io(i,k) @@ -355,9 +356,9 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & CNV_UPDF(i,k) = cf_upi(i,k) CNV_DQLDT(I,K) = CNV_DQLDT_i(I,k) CLCN(I,k) = CLCN_i(I,k) - CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),0.0) - PLO(i,k) = prsl_i(i,k)*0.01 - zlo(i,k) = phil(i,k) * (1.0/grav) + CLLS(I,k) = max(CLLS_io(I,k)-CLCN_i(I,k),zero) + PLO(i,k) = prsl_i(i,k)*0.01d0 + zlo(i,k) = phil(i,k) * onebg temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) rhc(i,k) = rhc_i(i,k) @@ -370,8 +371,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & END DO DO K=0, LM DO I = 1,IM - PLE(i,k) = prsi_i(i,k) *.01 ! interface pressure in hPa - zet(i,k+1) = phii(i,k) * (1.0/grav) + PLE(i,k) = prsi_i(i,k) * 0.01d0 ! interface pressure in hPa + zet(i,k+1) = phii(i,k) * onebg END DO END DO if (.not. skip_macro) then @@ -408,19 +409,19 @@ 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 - ncpr(i,k) = 0.0 + ncpr(i,k) = zero 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) + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncps(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo @@ -433,8 +434,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & DO I=1, IM DO K = LM-2, 10, -1 - If ((CNV_DQLDT(I,K) <= 1.0e-9) .and. & - & (CNV_DQLDT(I,K+1) > 1.0e-9)) then + If ((CNV_DQLDT(I,K) <= 1.0d-9) .and. & + & (CNV_DQLDT(I,K+1) > 1.0d-9)) then KCT(I) = K+1 exit end if @@ -514,8 +515,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & do l=lm-1,1,-1 do i=1,im - tx1 = 0.5 * (temp(i,l+1) + temp(i,l)) - kh(i,l) = 3.55e-7*tx1**2.5*(rgas*0.01) / ple(i,l) !kh molecule diff only needing refinement + tx1 = half * (temp(i,l+1) + temp(i,l)) + kh(i,l) = 3.55d-7*tx1**2.5d0*(rgas*0.01d0) / ple(i,l) !kh molecule diff only needing refinement enddo end do do i=1,im @@ -524,38 +525,38 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & enddo do L=LM,1,-1 do i=1,im - blk_l(i,l) = 1.0 / ( 1.0/max(0.15*ZPBL(i),0.4*zlo(i,lm-1))& - & + 1.0/(zlo(i,l)*.4) ) + blk_l(i,l) = one / (one/max(0.15d0*ZPBL(i),0.4d0*zlo(i,lm-1))& + & + one/(zlo(i,l)*.4d0) ) - SC_ICE(i,l) = 1.0 - NCPL(i,l) = MAX( NCPL(i,l), 0.) - NCPI(i,l) = MAX( NCPI(i,l), 0.) - RAD_CF(i,l) = max(0.0, min(CLLS(i,l)+CLCN(i,l), 1.0)) + SC_ICE(i,l) = one + NCPL(i,l) = MAX( NCPL(i,l), 0.0d0) + NCPI(i,l) = MAX( NCPI(i,l), 0.0d0) + RAD_CF(i,l) = max(zero, min(CLLS(i,l)+CLCN(i,l), one)) if (.not. iccn) then - CDNC_NUC(i,l) = 0.0 - INC_NUC(i,l) = 0.0 + CDNC_NUC(i,l) = zero + INC_NUC(i,l) = zero endif enddo end do ! T_ICE_ALL = TICE - 40.0 T_ICE_ALL = CLOUDPARAMS(33) + TICE - t_ice_denom = 1.0 / (tice - t_ice_all) + t_ice_denom = one / (tice - t_ice_all) do l=1,lm - rhdfdar8(l) = 1.e-8 - rhu00r8(l) = 0.95 + rhdfdar8(l) = 1.d-8 + rhu00r8(l) = 0.95d0 - ttendr8(l) = 0. - qtendr8(l) = 0. - cwtendr8(l) = 0. + ttendr8(l) = zero + qtendr8(l) = zero + cwtendr8(l) = zero - npccninr8(l) = 0. + npccninr8(l) = zero enddo do k=1,10 do l=1,lm - rndstr8(l,k) = 2.0e-7 + rndstr8(l,k) = 2.0d-7 enddo enddo @@ -589,14 +590,14 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & if ( aero_in ) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else - AERMASSMIX(:,:,1:5) = 1.e-6 - AERMASSMIX(:,:,6:15) = 2.e-14 + AERMASSMIX(:,:,1:5) = 1.0d-6 + AERMASSMIX(:,:,6:15) = 2.0d-14 end if call AerConversion1 (AERMASSMIX, AeroProps) deallocate(AERMASSMIX) use_average_v = .false. - if (USE_AV_V > 0.0) then + if (USE_AV_V > zero) then use_average_v = .true. end if @@ -607,58 +608,58 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & kcldtopcvn = KCT(I) - tausurf_gw = min(0.5*SQRT(TAUOROX(I)*TAUOROX(I) & - & + TAUOROY(I)*TAUOROY(I)), 10.0) + tausurf_gw = min(half*SQRT(TAUOROX(I)*TAUOROX(I) & + & + TAUOROY(I)*TAUOROY(I)), 10.0d0) do k=1,lm - uwind_gw(k) = min(0.5*SQRT( U1(I,k)*U1(I,k) & - & + V1(I,k)*V1(I,k)), 50.0) + uwind_gw(k) = min(half*SQRT( U1(I,k)*U1(I,k) & + & + V1(I,k)*V1(I,k)), 50.0d0) ! tausurf_gw =tausurf_gw + max (tausurf_gw, min(0.5*SQRT(TAUX(I , J)**2+TAUY(I , J)**2), 10.0)*BKGTAU) !adds a minimum value from unresolved sources - pm_gw(k) = 100.0*PLO(I,k) + pm_gw(k) = 100.0d0*PLO(I,k) tm_gw(k) = TEMP(I,k) - nm_gw(k) = 0.0 + nm_gw(k) = zero rho_gw(k) = pm_gw(k) /(RGAS*tm_gw(k)) ter8(k) = TEMP(I,k) - plevr8(k) = 100.*PLO(I,k) + plevr8(k) = 100.0d0*PLO(I,k) ndropr8(k) = NCPL(I,k) qir8(k) = QILS(I,k) + QICN(I,k) qcr8(k) = QLLS(I,k) + QLCN(I,k) qcaux(k) = qcr8(k) - npccninr8(k) = 0.0 - naair8(k) = 0.0 + npccninr8(k) = zero + naair8(k) = zero - npre8(k) = 0.0 + npre8(k) = zero - if (RAD_CF(I,k) > 0.01 .and. qir8(k) > 0.0) then + if (RAD_CF(I,k) > 0.01d0 .and. qir8(k) > zero) then npre8(k) = NPRE_FRAC*NCPI(I,k) else - npre8(k) = 0.0 + npre8(k) = zero endif omegr8(k) = OMEGA(I,k) - lc_turb(k) = max(blk_l(I,k), 50.0) + lc_turb(k) = max(blk_l(I,k), 50.0d0) ! rad_cooling(k) = RADheat(I,k) - if (npre8(k) > 0.0 .and. qir8(k) > 0.0) then - dpre8(k) = ( qir8(k)/(6.0*npre8(k)*900.0*PI))**(1.0/3.0) + if (npre8(k) > zero .and. qir8(k) > zero) then + dpre8(k) = ( qir8(k)/(6.0*npre8(k)*900.0d0*PI))**(one/3.0d0) else - dpre8(k) = 1.0e-9 + dpre8(k) = 1.0d-9 endif wparc_ls(k) = -omegr8(k) / (rho_gw(k)*GRAV) & & + cpbg * radheat(i,k) ! & + cpbg * rad_cooling(k) enddo do k=0,lm - pi_gw(k) = 100.0*PLE(I,k) - rhoi_gw(k) = 0.0 - ni_gw(k) = 0.0 - ti_gw(k) = 0.0 + pi_gw(k) = 100.0d0*PLE(I,k) + rhoi_gw(k) = zero + ni_gw(k) = zero + ti_gw(k) = zero enddo @@ -671,37 +672,37 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & ti_gw, nm_gw, q1(i,:)) do k=1,lm - nm_gw(k) = max(nm_gw(k), 0.005) + nm_gw(k) = max(nm_gw(k), 0.005d0) h_gw(k) = k_gw*rho_gw(k)*uwind_gw(k)*nm_gw(k) - if (h_gw(K) > 0.0) then - h_gw(K) = sqrt(2.0*tausurf_gw/h_gw(K)) + if (h_gw(K) > zero) then + h_gw(K) = sqrt(2.0d0*tausurf_gw/h_gw(K)) end if - wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133 + wparc_gw(k) = k_gw*uwind_gw(k)*h_gw(k)*0.133d0 - wparc_cgw(k) = 0.0 + wparc_cgw(k) = zero end do !!!======== Subgrid variability from Convective Sources According to Barahona et al. 2014 in prep if (kcldtopcvn > 20) then - ksa1 = 1.0 + ksa1 = one Nct = nm_gw(kcldtopcvn) - Wct = max(CNV_CVW(I,kcldtopcvn), 0.0) + Wct = max(CNV_CVW(I,kcldtopcvn), zero) fcn = maxval(CNV_UPDF(I,kcldtopcvn:LM)) do k=1,kcldtopcvn c2_gw = (nm_gw(k) + Nct) / Nct - wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56* & - & 1.806*c2_gw*c2_gw)*Wct*0.133 + wparc_cgw(k) = sqrt(ksa1*fcn*fcn*12.56d0* & + & 1.806d0*c2_gw*c2_gw)*Wct*0.133d0 enddo end if do k=1,lm - dummyW(k) = 0.133*k_gw*uwind_gw(k)/nm_gw(k) + dummyW(k) = 0.133d0*k_gw*uwind_gw(k)/nm_gw(k) enddo do K=1, LM-5, 1 @@ -711,8 +712,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & end do do l=1,min(k,lm-5) - wparc_cgw(l) = 0.0 - wparc_gw(l) = 0.0 + wparc_cgw(l) = zero + wparc_gw(l) = zero enddo @@ -721,25 +722,25 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & kbmin = min(kbmin, LM-1) - 4 do K = 1, LM wparc_turb(k) = KH(I,k) / lc_turb(k) - dummyW(k) = 10.0 + dummyW(k) = 10.0d0 enddo - if (FRLAND(I) < 0.1 .and. ZPBL(I) < 800.0 .and. & - & TEMP(I,LM) < 298.0 .and. TEMP(I,LM) > 274.0 ) then + if (FRLAND(I) < 0.1d0 .and. ZPBL(I) < 800.0d0 .and. & + & TEMP(I,LM) < 298.0d0 .and. TEMP(I,LM) > 274.0d0 ) then do K = 1, LM - dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01,10.0),-10.0) - dummyW(k) = 1.0 / (1.0+exp(dummyW(k))) + dummyW(k) = max(min((ZET(I,k+1)-ZPBL(I))*0.01d0,10.0d0),-10.0d0) + dummyW(k) = one / (one+exp(dummyW(k))) enddo maxkh = max(maxval(KH(I,kbmin:LM-1)*nm_gw(kbmin:LM-1)/ & - & 0.17), 0.3) + & 0.17d0), 0.3d0) do K = 1, LM - wparc_turb(k) = (1.0-dummyW(k))*wparc_turb(k) & - & + dummyW(k)*maxkh + wparc_turb(k) = (one-dummyW(k))*wparc_turb(k) & + & + dummyW(k)*maxkh enddo end if - wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2) + wparc_turb(kbmin:LM) = max(wparc_turb(kbmin:LM), 0.2d0) @@ -757,11 +758,11 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & do K = 1, LM - if (plevr8(K) > 70.0) then + if (plevr8(K) > 70.0d0) then - ccn_diag(1) = 0.001 - ccn_diag(2) = 0.004 - ccn_diag(3) = 0.01 + ccn_diag(1) = 0.001d0 + ccn_diag(2) = 0.004d0 + ccn_diag(3) = 0.01d0 if (K > 2 .and. K <= LM-2) then tauxr8 = (ter8(K-1) + ter8(K+1) + ter8(K)) * oneb3 @@ -776,8 +777,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! call init_Aer(AeroAux_b) ! endif - pfrz_inc_r8(k) = 0.0 - rh1_r8 = 0.0 !related to cnv_dql_dt, needed to changed soon + pfrz_inc_r8(k) = zero + rh1_r8 = zero !related to cnv_dql_dt, needed to changed soon ! if (lprnt) write(0,*)' bef aero npccninr8=',npccninr8(k),' k=',k & ! &,' ccn_param=',ccn_param,' in_param=',in_param & @@ -797,7 +798,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! & size(ccn_diag), lprnt) ! if (lprnt) write(0,*)' aft aero npccninr8=',npccninr8(k),' k=',k - if (npccninr8(k) < 1.0e-12) npccninr8(k) = 0.0 + if (npccninr8(k) < 1.0d-12) npccninr8(k) = zero ! CCN01(I,K) = max(ccn_diag(1)*1e-6, 0.0) ! CCN04(I,K) = max(ccn_diag(2)*1e-6, 0.0) @@ -806,31 +807,31 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & else - ccn_diag(:) = 0.0 - smaxliq(K) = 0.0 - swparc(K) = 0.0 - smaxicer8(K) = 0.0 - nheticer8(K) = 0.0 - sc_icer8(K) = 2.0 + ccn_diag(:) = zero + smaxliq(K) = zero + swparc(K) = zero + smaxicer8(K) = zero + nheticer8(K) = zero + sc_icer8(K) = 2.0d0 ! sc_icer8(K) = 1.0 - naair8(K) = 0.0 - npccninr8(K) = 0.0 - nlimicer8(K) = 0.0 - nhet_immr8(K) = 0.0 - dnhet_immr8(K) = 0.0 - nhet_depr8(K) = 0.0 - nhet_dhfr8(K) = 0.0 - dust_immr8(K) = 0.0 - dust_depr8(K) = 0.0 - dust_dhfr8(K) = 0.0 + naair8(K) = zero + npccninr8(K) = zero + nlimicer8(K) = zero + nhet_immr8(K) = zero + dnhet_immr8(K) = zero + nhet_depr8(K) = zero + nhet_dhfr8(K) = zero + dust_immr8(K) = zero + dust_depr8(K) = zero + dust_dhfr8(K) = zero end if ! SMAXL(I,k) = smaxliq(k) * 100.0 ! SMAXI(I,k) = smaxicer8(k) * 100.0 - NHET_NUC(I,k) = nheticer8(k) * 1e-6 - NLIM_NUC(I,k) = nlimicer8(k) * 1e-6 - SC_ICE(I,k) = min(max(sc_icer8(k),1.0),2.0) + NHET_NUC(I,k) = nheticer8(k) * 1.0d-6 + NLIM_NUC(I,k) = nlimicer8(k) * 1.0d-6 + SC_ICE(I,k) = min(max(sc_icer8(k),one),2.0d0) ! SC_ICE(I,k) = min(max(sc_icer8(k),1.0),1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) ! if(temp(i,k) < T_ICE_ALL) SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) @@ -853,14 +854,14 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & CDNC_NUC(I,k) = npccninr8(k) INC_NUC (I,k) = naair8(k) endif - NHET_IMM(I,k) = max(nhet_immr8(k), 0.0) - DNHET_IMM(I,k) = max(dnhet_immr8(k), 0.0) - NHET_DEP(I,k) = nhet_depr8(k) * 1e-6 - NHET_DHF(I,k) = nhet_dhfr8(k) * 1e-6 - DUST_IMM(I,k) = max(dust_immr8(k), 0.0)*1e-6 - DUST_DEP(I,k) = max(dust_depr8(k), 0.0)*1e-6 - DUST_DHF(I,k) = max(dust_dhfr8(k), 0.0)*1e-6 - WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8 + NHET_IMM(I,k) = max(nhet_immr8(k), zero) + DNHET_IMM(I,k) = max(dnhet_immr8(k), zero) + NHET_DEP(I,k) = nhet_depr8(k) * 1.0d-6 + NHET_DHF(I,k) = nhet_dhfr8(k) * 1.0d-6 + DUST_IMM(I,k) = max(dust_immr8(k), zero)*1.0d-6 + DUST_DEP(I,k) = max(dust_depr8(k), zero)*1.0d-6 + DUST_DHF(I,k) = max(dust_dhfr8(k), zero)*1.0d-6 + WSUB (I,k) = wparc_ls(k) + swparc(k)*0.8d0 SIGW_GW (I,k) = wparc_gw(k) * wparc_gw(k) SIGW_CNV (I,k) = wparc_cgw(k) * wparc_cgw(k) SIGW_TURB (I,k) = wparc_turb(k) * wparc_turb(k) @@ -973,24 +974,24 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & do k=1,lm do i=1,im - if (CNV_MFD(i,k) > 1.0e-6) then - tx1 = 1.0 / CNV_MFD(i,k) + if (CNV_MFD(i,k) > 1.0d-6) then + tx1 = one / CNV_MFD(i,k) CNV_NDROP(i,k) = CNV_NDROP(i,k) * tx1 CNV_NICE(i,k) = CNV_NICE(i,k) * tx1 else - CNV_NDROP(i,k) = 0.0 - CNV_NICE(i,k) = 0.0 + CNV_NDROP(i,k) = zero + CNV_NICE(i,k) = zero endif ! temp(i,k) = th1(i,k) * PK(i,k) - RAD_CF(i,k) = min(CLLS(i,k)+CLCN(i,k), 1.0) + RAD_CF(i,k) = min(CLLS(i,k)+CLCN(i,k), one) ! if (.not. iccn) then - if (PFRZ(i,k) > 0.0) then + if (PFRZ(i,k) > zero) then INC_NUC(i,k) = INC_NUC(i,k) * PFRZ(i,k) NHET_NUC(i,k) = NHET_NUC(i,k) * PFRZ(i,k) else - INC_NUC(i,k) = 0.0 - NHET_NUC(i,k) = 0.0 + INC_NUC(i,k) = zero + NHET_NUC(i,k) = zero endif endif @@ -1046,21 +1047,21 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & QL_TOT(i,k) = QLCN(i,k) + QLLS(i,k) QI_TOT(i,k) = QICN(i,k) + QILS(i,k) ! Anning if negative, borrow water and ice from vapor 11/23/2016 - if (QL_TOT(i,k) < 0.0) then + if (QL_TOT(i,k) < zero) then Q1(i,k) = Q1(i,k) + QL_TOT(i,k) TEMP(i,k) = TEMP(i,k) - lvbcp*QL_TOT(i,k) - QL_TOT(i,k) = 0.0 + QL_TOT(i,k) = zero endif - if (QI_TOT(i,k) < 0.0) then + if (QI_TOT(i,k) < zero) then Q1(i,k) = Q1(i,k) + QI_TOT(i,k) TEMP(i,k) = TEMP(i,k) - lsbcp*QI_TOT(i,k) - QI_TOT(i,k) = 0.0 + QI_TOT(i,k) = zero endif QTOT = QL_TOT(i,k) + QI_TOT(i,k) - if (QTOT > 0.0) then - FQA(i,k) = min(max(QCNTOT / QTOT, 0.0), 1.0) + if (QTOT > zero) then + FQA(i,k) = min(max(QCNTOT / QTOT, zero), one) else - FQA(i,k) = 0.0 + FQA(i,k) = zero endif enddo enddo @@ -1071,35 +1072,35 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & !============================================================================================= do I=1,IM - LS_SNR(i) = 0.0 - LS_PRC2(i) = 0.0 + LS_SNR(i) = zero + LS_PRC2(i) = zero nbincontactdust = 1 do l=1,10 do k=1,lm - naconr8(k,l) = 0.0 - rndstr8(k,l) = 2.0e-7 + naconr8(k,l) = zero + rndstr8(k,l) = 2.0d-7 enddo enddo do k=1,lm - npccninr8(k) = 0.0 - naair8(k) = 0.0 - omegr8(k) = 0.0 + npccninr8(k) = zero + naair8(k) = zero + omegr8(k) = zero ! tx1 = MIN(CLLS(I,k) + CLCN(I,k), 0.99) - tx1 = MIN(CLLS(I,k) + CLCN(I,k), 1.00) - if (tx1 > 0.0) then - cldfr8(k) = min(max(tx1, 0.00001), 1.0) + tx1 = MIN(CLLS(I,k) + CLCN(I,k), one) + if (tx1 > zero) then + cldfr8(k) = min(max(tx1, 0.00001d0), one) else - cldfr8(k) = 0.0 + cldfr8(k) = zero endif if (temp(i,k) > tice) then liqcldfr8(k) = cldfr8(k) - icecldfr8(k) = 0.0 + icecldfr8(k) = zero elseif (temp(i,k) <= t_ice_all) then - liqcldfr8(k) = 0.0 + liqcldfr8(k) = zero icecldfr8(k) = cldfr8(k) else icecldfr8(k) = cldfr8(k) * (tice - temp(i,k))/(tice-t_ice_all) @@ -1113,23 +1114,23 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & qcr8(k) = QL_TOT(I,k) qir8(k) = QI_TOT(I,k) - ncr8(k) = MAX(NCPL(I,k), 0.0) - nir8(k) = MAX(NCPI(I,k), 0.0) + ncr8(k) = MAX(NCPL(I,k), zero) + nir8(k) = MAX(NCPI(I,k), zero) qrr8(k) = rnw(I,k) qsr8(k) = snw(I,k) qgr8(k) = qgl(I,k) - nrr8(k) = MAX(NCPR(I,k), 0.0) - nsr8(k) = MAX(NCPS(I,k), 0.0) - ngr8(k) = MAX(ncgl(I,k), 0.0) + nrr8(k) = MAX(NCPR(I,k), zero) + nsr8(k) = MAX(NCPS(I,k), zero) + ngr8(k) = MAX(ncgl(I,k), zero) naair8(k) = INC_NUC(I,k) npccninr8(k) = CDNC_NUC(I,k) - if (cldfr8(k) >= 0.001) then + if (cldfr8(k) >= 0.001d0) then nimmr8(k) = min(DNHET_IMM(I,k),ncr8(k)/(cldfr8(k)*DT_MOIST)) else - nimmr8(k) = 0.0 + nimmr8(k) = zero endif @@ -1144,7 +1145,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & nbincontactdust = naux endif naconr8(K, 1:naux) = AeroAux_b%num(1:naux) - rndstr8(K, 1:naux) = AeroAux_b%dpg(1:naux) * 0.5 + rndstr8(K, 1:naux) = AeroAux_b%dpg(1:naux) * half ! The following moved inside of if(fprcp <= 0) then loop ! Get black carbon properties for contact ice nucleation @@ -1153,11 +1154,11 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! naux = AeroAux_b%nmods ! rnsootr8 (K) = sum(AeroAux_b%dpg(1:naux))/naux - pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0 - rpdelr8(k) = 1. / pdelr8(k) - plevr8(k) = 100. * PLO(I,k) + pdelr8(k) = (PLE(I,k) - PLE(I,k-1)) * 100.0d0 + rpdelr8(k) = one / pdelr8(k) + plevr8(k) = 100.0d0 * PLO(I,k) zmr8(k) = ZLO(I,k) - ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.e-10) + ficer8(k) = qir8(k) / (qcr8(k)+qir8(k) + 1.0d-10) omegr8(k) = WSUB(I,k) ! alphar8(k) = max(alpht_x(i,k)/maxval(alpht_x(i,:))*8.,0.5) ! alphar8(k) = qcvar2 @@ -1165,12 +1166,12 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & END DO do k=1,lm+1 - pintr8(k) = PLE(I,k-1) * 100.0 + pintr8(k) = PLE(I,k-1) * 100.0d0 kkvhr8(k) = KH(I,k-1) END DO lev_sed_strt = 0 - tx1 = 1.0 / pintr8(lm+1) + tx1 = one / pintr8(lm+1) do k=1,lm if (plevr8(k)*tx1 < sig_sed_strt) then lev_sed_strt(1) = k @@ -1250,8 +1251,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! if (lprint) write(0,*)' prectr8=',prectr8(1), & ! & ' precir8=',precir8(1) - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm @@ -1262,17 +1263,17 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! &,' qvlatr8=',qvlatr8(k) TEMP(I,k) = TEMP(I,k) + tlatr8(k)*DT_R8*onebcp - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_R8, 0.0) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k) * DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k) * DT_R8, zero) rnw(I,k) = qrr8(k) snw(I,k) = qsr8(k) NCPR(I,k) = nrr8(k) NCPS(I,k) = nsr8(k) - CLDREFFL(I,k) = min(max(effcr8(k), 10.), 150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.), 150.) - CLDREFFR(I,k) = max(droutr8(k)*0.5*1.e6, 150.) - CLDREFFS(I,k) = max(0.192*dsoutr8(k)*0.5*1.e6, 250.) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0), 150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0), 150.0d0) + CLDREFFR(I,k) = max(droutr8(k)*0.5*1.0d6, 150.0d0) + CLDREFFS(I,k) = max(0.192d0*dsoutr8(k)*0.5d0*1.0d6, 250.0d0) enddo ! K loop @@ -1354,8 +1355,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1364,15 +1365,15 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & rnw(I,k) = rnw(I,k) + qrtend(k)*dt_r8 snw(I,k) = snw(I,k) + qstend(k)*dt_r8 - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, 0.0) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, 0.0) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, 0.0) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) - CLDREFFL(I,k) = min(max(effcr8(k), 10.),150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.),150.) - CLDREFFR(I,k) = max(reff_rain(k),150.) - CLDREFFS(I,k) = max(reff_snow(k),250.) + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),1500.0d0) + CLDREFFR(I,k) = max(reff_rain(k),150.0d0) + CLDREFFS(I,k) = max(reff_snow(k),250.0d0) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1380,13 +1381,13 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! write(0,*)' aft micro_mg_tend LS_PRC2= ', LS_PRC2(i),' ls_snr=',ls_snr(i) ! endif else - LS_PRC2(I) = 0. - LS_SNR(I) = 0. + LS_PRC2(I) = zero + LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10. - CLDREFFI(I,k) = 50. - CLDREFFR(I,k) = 1000. - CLDREFFS(I,k) = 250. + CLDREFFL(I,k) = 10.0d0 + CLDREFFI(I,k) = 50.0d0 + CLDREFFR(I,k) = 1000.0d0 + CLDREFFS(I,k) = 250.0d0 enddo ! K loop endif ! @@ -1490,8 +1491,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & & lev_sed_strt) - LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) - LS_SNR(I) = max(1000.*precir8(1), 0.0) + LS_PRC2(I) = max(1000.d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1501,17 +1502,17 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & snw(I,k) = snw(I,k) + qstend(k)*dt_r8 qgl(I,k) = qgl(I,k) + qgtend(k)*dt_r8 - NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, 0.0) - NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, 0.0) - NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, 0.0) - NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, 0.0) - NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, 0.0) - - CLDREFFL(I,k) = min(max(effcr8(k), 10.),150.) - CLDREFFI(I,k) = min(max(effir8(k), 20.),150.) - CLDREFFR(I,k) = max(reff_rain(k),150.) - CLDREFFS(I,k) = max(reff_snow(k),250.) - CLDREFFG(I,k) = max(reff_grau(k),250.) + NCPL(I,k) = MAX(NCPL(I,k) + nctendr8(k)*DT_R8, zero) + NCPI(I,k) = MAX(NCPI(I,k) + nitendr8(k)*DT_R8, zero) + NCPR(I,k) = max(NCPR(I,k) + nrtend(k)*dt_r8, zero) + NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) + NCGL(I,k) = max(NCGL(I,k) + ngtend(k)*dt_r8, zero) + + CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) + CLDREFFR(I,k) = max(reff_rain(k),150.0d0) + CLDREFFS(I,k) = max(reff_snow(k),250.0d0) + CLDREFFG(I,k) = max(reff_grau(k),250.0d0) enddo ! K loop ! if (lprint) then ! write(0,*)' aft micro_mg_tend temp= ', temp(i,:) @@ -1519,14 +1520,14 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! write(0,*)' aft micro_mg_tend LS_PRC2= ', LS_PRC2(i),' ls_snr=',ls_snr(i) ! endif else - LS_PRC2(I) = 0. - LS_SNR(I) = 0. + LS_PRC2(I) = zero + LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 10. - CLDREFFI(I,k) = 50. - CLDREFFR(I,k) = 1000. - CLDREFFS(I,k) = 250. - CLDREFFG(I,k) = 250. + CLDREFFL(I,k) = 100.0d0 + CLDREFFI(I,k) = 500.0d0 + CLDREFFR(I,k) = 1000.0d0 + CLDREFFS(I,k) = 250.0d0 + CLDREFFG(I,k) = 250.0d0 enddo ! K loop endif endif @@ -1553,19 +1554,19 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & 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 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = zero + 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.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo enddo @@ -1592,19 +1593,19 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & 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 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = zero + 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.0d0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = zero elseif (ncps(i,k) <= nmin) then - ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif if (qgl(i,k) <= qc_min(2)) then - ncgl(i,k) = 0.0 + ncgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then - ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) + ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0d0), nmin) endif enddo enddo @@ -1618,8 +1619,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & do K= 1, LM do I=1,IM - if (QI_TOT(i,k) <= 0.0) NCPI(i,k) = 0.0 - if (QL_TOT(i,k) <= 0.0) NCPL(i,k) = 0.0 + if (QI_TOT(i,k) <= zero) NCPI(i,k) = zero + if (QL_TOT(i,k) <= zero) NCPL(i,k) = zero end do end do @@ -1651,7 +1652,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & DO K=1, LM ll = lm-k+1 DO I = 1,IM - CLLS_io(i,k) = max(0.0, min(CLLS(i,ll)+CLCN(i,ll),1.0)) + CLLS_io(i,k) = max(zero, min(CLLS(i,ll)+CLCN(i,ll),one)) enddo enddo else @@ -1682,7 +1683,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & if (skip_macro) then DO K=1, LM DO I = 1,IM - CLLS_io(i,k) = max(0.0, min(CLLS(i,k)+CLCN(i,k),1.0)) + CLLS_io(i,k) = max(zero, min(CLLS(i,k)+CLCN(i,k),one)) enddo enddo else @@ -1696,12 +1697,12 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & DO I = 1,IM tx1 = LS_PRC2(i) + LS_SNR(i) - rn_o(i) = tx1 * dt_i * 0.001 + rn_o(i) = tx1 * dt_i * 0.001d0 if (rn_o(i) < rainmin) then - sr_o(i) = 0. + sr_o(i) = zero else - sr_o(i) = LS_SNR(i) / tx1 + sr_o(i) = max(zero, min(one, LS_SNR(i)/tx1)) endif ENDDO @@ -1833,7 +1834,7 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) ibot = pver-1 kcldtop = ibot+1 kuppest = 20 - cfcrit = 1e-2 + cfcrit = 1.0d-2 do k = kuppest , ibot diff --git a/gfsphysics/physics/micro_mg3_0.F90 b/gfsphysics/physics/micro_mg3_0.F90 index f27aa1896..89db1e34a 100644 --- a/gfsphysics/physics/micro_mg3_0.F90 +++ b/gfsphysics/physics/micro_mg3_0.F90 @@ -316,7 +316,7 @@ subroutine micro_mg_init( & !----------------------------------------------------------------------- - dcs = micro_mg_dcs * 1.0e-6 + dcs = micro_mg_dcs * 1.0d-6 ts_au_min = ts_auto(1) ts_au = ts_auto(2) qcvar = mg_qcvar @@ -1073,7 +1073,7 @@ subroutine micro_mg_tend ( & ! logical, parameter :: do_ice_gmao=.true., do_liq_liu=.false. ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & - real(r8), parameter :: qimax=0.010, qimin=0.005, qiinv=one/(qimax-qimin) + real(r8), parameter :: qimax=0.010_r8, qimin=0.005_r8, qiinv=one/(qimax-qimin) ! ts_au_min=180.0 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -3174,9 +3174,9 @@ subroutine micro_mg_tend ( & !++ag Add graupel dumg(i,k) = (qg(i,k)+qgtend(i,k)*deltat) * tx1 ! Moorthi testing - if (dumg(i,k) > 0.01) then - tx2 = dumg(i,k) - 0.01 - dumg(i,k) = 0.01 + if (dumg(i,k) > 0.01_r8) then + tx2 = dumg(i,k) - 0.01_r8 + dumg(i,k) = 0.01_r8 dums(i,k) = dums(i,k) + tx2 qstend(i,k) = (dums(i,k)*precip_frac(i,k) - qs(i,k)) * oneodt qgtend(i,k) = (dumg(i,k)*precip_frac(i,k) - qg(i,k)) * oneodt @@ -3778,9 +3778,9 @@ subroutine micro_mg_tend ( & !++ag dumg(i,k) = max(qg(i,k)+qgtend(i,k)*deltat, zero) ! Moorthi testing - if (dumg(i,k) > 0.01) then - tx2 = dumg(i,k) - 0.01 - dumg(i,k) = 0.01 + if (dumg(i,k) > 0.01_r8) then + tx2 = dumg(i,k) - 0.01_r8 + dumg(i,k) = 0.01_r8 dums(i,k) = dums(i,k) + tx2 qstend(i,k) = (dums(i,k) - qs(i,k)) * oneodt qgtend(i,k) = (dumg(i,k) - qg(i,k)) * oneodt @@ -4029,7 +4029,7 @@ subroutine micro_mg_tend ( & ! qvn = epsqs*esn/(p(i,k)-omeps*esn) - if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then + if (qtmp > qvn .and. qvn > zero .and. allow_sed_supersat) then ! expression below is approximate since there may be ice deposition dum = (qtmp-qvn)/(one+xxlv_squared*qvn/(cpp*rv*ttmp*ttmp)) * oneodt ! add to output cme diff --git a/gfsphysics/physics/micro_mg_utils.F90 b/gfsphysics/physics/micro_mg_utils.F90 index ab20ec7cf..53518bef7 100644 --- a/gfsphysics/physics/micro_mg_utils.F90 +++ b/gfsphysics/physics/micro_mg_utils.F90 @@ -480,10 +480,10 @@ elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc if (liq_gmao) then pgam = 0.0005714_r8*1.e-6_r8*ncic*rho + 0.2714_r8 ! Anning modified lamc - if ((ncic > 1.0e-3) .and. (qcic > 1.0e-11)) then + if ((ncic > 1.0e-3_r8) .and. (qcic > 1.0e-11_r8)) then xs = 0.07_r8*(1000._r8*qcic/ncic) ** (-0.14_r8) else - xs = 1.2 + xs = 1.2_r8 end if xs = max(min(xs, 1.7_r8), 1.1_r8) @@ -549,15 +549,15 @@ subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) if (liq_gmao) then pgam(i) = 0.0005714_r8*1.e-6_r8*ncic(i)*rho(i) + 0.2714_r8 - if ((ncic(i) > 1.0e-3) .and. (qcic(i) > 1.0e-11)) then + if ((ncic(i) > 1.0e-3_r8) .and. (qcic(i) > 1.0e-11_r8)) then xs = 0.07_r8*(1000._r8*qcic(i)/ncic(i)) **(-0.14_r8) else - xs = 1.2 + xs = 1.2_r8 end if xs = max(min(xs, 1.7_r8), 1.1_r8) xs = xs*xs*xs - xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.)/8.0_r8 + xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8 pgam(i) = sqrt(xs) else pgam(i) = one - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic(i)*rho(i)) @@ -707,12 +707,12 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) miu_ice = max(min(0.008_r8*(lam*0.01)**0.87_r8, 10.0_r8), 0.1_r8) tx1 = 1. + miu_ice tx2 = 1. / gamma(tx1) - aux = (gamma(tx1+3.)*tx2) ** (1./3.) + aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8) lam = lam*aux else - aux = 1. - tx1 = 1.0 - tx2 = 1.0 + aux = 1.0_r8 + tx1 = 1.0_r8 + tx2 = 1.0_r8 end if if (present(n0)) n0 = nic * lam**tx1*tx2 @@ -729,7 +729,7 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) end if else - lam = 0._r8 + lam = 0.0_r8 end if @@ -762,14 +762,14 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) lam(i) = (props%shape_coef * nic(i)/qic(i))**(1._r8/props%eff_dim) if (ice_sep) then miu_ice = max(min(0.008_r8*(lam(i)*0.01)**0.87_r8, 10.0_r8), 0.1_r8) - tx1 = 1. + miu_ice - tx2 = 1. / gamma(tx1) - aux = (gamma(tx1+3.)*tx2) ** (1./3.) + tx1 = 1.0_r8 + miu_ice + tx2 = 1.0_r8 / gamma(tx1) + aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8) lam(i) = lam(i)*aux else - aux = 1. - tx1 = 1.0 - tx2 = 1.0 + aux = 1.0_r8 + tx1 = 1.0_r8 + tx2 = 1.0_r8 end if if (present(n0)) n0(i) = nic(i) * lam(i)**tx1*tx2 @@ -786,7 +786,7 @@ subroutine size_dist_param_ice_vect(props, qic, nic, lam, mgncol, n0) end if else - lam(i) = 0._r8 + lam(i) = 0.0_r8 end if enddo @@ -1103,10 +1103,10 @@ subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & LW = 1.0e-3_r8 * qc(i) * rho(i) NW = nc(i) * rho(i) * 1.e-6_r8 - xs = min(20.0, 1.03e16*(LW*LW)/(NW*SQRT(NW))) - au(i) = 1.1e10*beta6*LW*LW*LW & + xs = min(20.0_r8, 1.03e16_r8*(LW*LW)/(NW*SQRT(NW))) + au(i) = 1.1e10_r8*beta6*LW*LW*LW & * (one-exp(-(xs**miu_disp))) / NW - au(i) = au(i)*1.0e3/rho(i) + au(i) = au(i)*1.0e3_r8/rho(i) au(i) = au(i) * gamma(two+relvar(i)) & / (gamma(relvar(i))*(relvar(i)*relvar(i))) @@ -2156,7 +2156,7 @@ subroutine graupel_collecting_snow(qsic,qric,umr,ums,rho,lamr,n0r,lams,n0s, & tx5 = tx4 * tx4 * tx3 psacr(i) = cons31 * tx1 * rho(i) * n0r(i) * n0s(i) * tx5 & - * (5.0*tx4+tx3*(tx2+tx2+0.5*tx3)) + * (5.0_r8*tx4+tx3*(tx2+tx2+0.5_r8*tx3)) ! psacr(i) = cons31*(((1.2_r8*umr(i)-0.95_r8*ums(i))**2+ & ! 0.08_r8*ums(i)*umr(i))**0.5_r8*rho(i)* & @@ -2208,7 +2208,7 @@ subroutine graupel_collecting_cld_water(qgic,qcic,ncic,rho,n0g,lamg,bg,agn, & do i=1,mgncol - if (qgic(i) >= 1.e-8 .and. qcic(i) >= qsmall) then + if (qgic(i) >= 1.e-8_r8 .and. qcic(i) >= qsmall) then tx1 = cons*agn(i)*rho(i)*n0g(i) / lamg(i)**(bg+three) @@ -2353,8 +2353,8 @@ subroutine graupel_collecting_rain(qric,qgic,umg,umr,ung,unr,rho,n0r,lamr,n0g,la ! pracg is mixing ratio of rain per sec collected by graupel/hail tx1 = 1.2_r8*umr(i) - 0.95_r8*umg(i) tx1 = sqrt(tx1*tx1+0.08_r8*umg(i)*umr(i)) - tx2 = 1.0 / lamr(i) - tx3 = 1.0 / lamg(i) + tx2 = 1.0_r8 / lamr(i) + tx3 = 1.0_r8 / lamg(i) tx4 = tx2 * tx2 tx5 = tx4 * tx4 * tx3 tx6 = rho(i) * n0r(i) * n0g(i) @@ -2717,10 +2717,10 @@ FUNCTION gamma_incomp(muice, x) real(r8) :: gamma_incomp REAL(r8), intent(in) :: muice, x REAL(r8) :: xog, kg, alfa, auxx - alfa = min(max(muice+1., 1.), 20._r8) + alfa = min(max(muice+1._r8, 1._r8), 20._r8) xog = log(alfa -0.3068_r8) - kg = 1.44818*(alfa**0.5357_r8) + kg = 1.44818_r8*(alfa**0.5357_r8) auxx = max(min(kg*(log(x)-xog), 30._r8), -30._r8) gamma_incomp = max(one/(one+exp(-auxx)), 1.0e-20) diff --git a/gfsphysics/physics/moninshoc.f b/gfsphysics/physics/moninshoc.f index d68c001b5..20a2adccc 100644 --- a/gfsphysics/physics/moninshoc.f +++ b/gfsphysics/physics/moninshoc.f @@ -65,16 +65,17 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, ttend, utend, vtend, qtend &, spdk2, rbint, ri, zol1, robn, bvf2 ! - real(kind=kind_phys), parameter :: gravi=1.0/grav, zolcr=0.2, - & zolcru=-0.5, rimin=-100., sfcfrac=0.1, - & crbcon=0.25, crbmin=0.15, crbmax=0.35, - & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, - & aphi5=5., aphi16=16., f0=1.e-4 - &, cont=cp/grav, conq=hvap/grav, conw=1.0/grav - &, dkmin=0.0, dkmax=1000. -! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 - &, gocp=grav/cp, prmin=0.25, prmax=4.0 - &, vk=0.4, cfac=6.5 + real(kind=kind_phys), parameter :: one=1.0d0, zero=0.0d0 + &, gravi=one/grav, zolcr=0.2d0 + &, zolcru=-0.5d0, rimin=-100.0d0, sfcfrac=0.1d0 + &, crbcon=0.25d0, crbmin=0.15d0, crbmax=0.35d0 + &, qmin=1.0d-8, zfmin=1.0d-8, qlmin=1.0d-12 + &, aphi5=5.0d0, aphi16=16.0d0, f0=1.0d-4 + &, cont=cp/grav, conq=hvap/grav, conw=one/grav + &, dkmin=zero, dkmax=1000.0d0 +! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 + &, gocp=grav/cp, prmin=0.25d0, prmax=4.0d0 + &, vk=0.4d0, cfac=6.5d0 ! !----------------------------------------------------------------------- ! @@ -108,24 +109,24 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,km1 do i=1,im - rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) - prnum(i,k) = 1.0 + rdzt(i,k) = one / (zl(i,k+1) - zl(i,k)) + prnum(i,k) = one enddo enddo ! Setup backgrond diffision do i=1,im - prnum(i,km) = 1.0 - tx1(i) = 1.0 / prsi(i,1) + prnum(i,km) = one + tx1(i) = one / prsi(i,1) enddo do k = 1,km1 do i=1,im - xkzo(i,k) = 0.0 - xkzmo(i,k) = 0.0 + xkzo(i,k) = zero + xkzmo(i,k) = zero ! if (k < kinver(i)) then if (k <= kinver(i)) then ! vertical background diffusivity for heat and momentum - tem1 = 1.0 - prsi(i,k+1) * tx1(i) - tem1 = min(1.0, exp(-tem1 * tem1 * 10.0)) + tem1 = one - prsi(i,k+1) * tx1(i) + tem1 = min(one, exp(-tem1 * tem1 * 10.0d0)) xkzo(i,k) = xkzm_h * tem1 xkzmo(i,k) = xkzm_m * tem1 endif @@ -141,9 +142,9 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! do k = 1,kmpbl do i=1,im - if(zi(i,k+1) > 250.) then + if(zi(i,k+1) > 250.0d0) then tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.e-5) then + if(tem1 > 1.0d-5) then xkzo(i,k) = min(xkzo(i,k),xkzminv) endif endif @@ -152,21 +153,21 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! do i = 1,im - z0(i) = 0.01 * zorl(i) + z0(i) = 0.01d0 * zorl(i) kpbl(i) = 1 hpbl(i) = zi(i,1) pblflg(i) = .true. sfcflg(i) = .true. - if(rbsoil(i) > 0.) sfcflg(i) = .false. - dusfc(i) = 0. - dvsfc(i) = 0. - dtsfc(i) = 0. - dqsfc(i) = 0. + if(rbsoil(i) > zero) sfcflg(i) = .false. + dusfc(i) = zero + dvsfc(i) = zero + dtsfc(i) = zero + dqsfc(i) = zero enddo ! do k = 1,km do i=1,im - tx1(i) = 0.0 + tx1(i) = zero enddo do kk=1,ncnd do i=1,im @@ -182,7 +183,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (lprnt) write(0,*)' heat=',heat(ipr),' evap=',evap(ipr) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) - if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + if(.not.sfcflg(i) .or. sflux(i) <= zero) pblflg(i)=.false. beta(i) = dt2 / (zi(i,2)-zi(i,1)) enddo ! @@ -197,11 +198,11 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, thermal(i) = thvx(i,1) crb(i) = crbcon else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = max(1.0, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) + thermal(i) = tsea(i)*(one+fv*max(q1(i,1,1),qmin)) + tem = max(one, sqrt(u10m(i)*u10m(i) + v10m(i)*v10m(i))) robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = max(min(0.16 * (tem1 ** (-0.18)), crbmax), crbmin) + tem1 = 1.0d-7 * robn + crb(i) = max(min(0.16d0 * (tem1**(-0.18d0)), crbmax), crbmin) endif enddo do k = 1, kmpbl @@ -220,9 +221,9 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if(kpbl(i) > 1) then k = kpbl(i) if(rbdn(i) >= crb(i)) then - rbint = 0. + rbint = zero elseif(rbup(i) <= crb(i)) then - rbint = 1. + rbint = one else rbint = (crb(i)-rbdn(i)) / (rbup(i)-rbdn(i)) endif @@ -245,13 +246,13 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) if(sfcflg(i)) then -! phim(i) = (1.-aphi16*zol1)**(-1./4.) -! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = 1.0 / max(1. - aphi16*zol1, 1.0e-8) +! phim(i) = (1.-aphi16*zol1)**(-one/4.0d0) +! phih(i) = (1.-aphi16*zol1)**(-one/2.0d0) + tem = one / max(one - aphi16*zol1, 1.0d-8) phih(i) = sqrt(tem) phim(i) = sqrt(phih(i)) else - phim(i) = 1. + aphi5*zol1 + phim(i) = one + aphi5*zol1 phih(i) = phim(i) endif enddo @@ -269,7 +270,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, do i = 1, im if(.not.flg(i)) then rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), 1.) + spdk2 = max((u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)), one) rbup(i) = (thvx(i,k)-thermal(i)) * phil(i,k) & / (thvx(i,1)*spdk2) kpbl(i) = k @@ -281,9 +282,9 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, if (pblflg(i)) then k = kpbl(i) if(rbdn(i) >= crb(i)) then - rbint = 0. + rbint = zero elseif(rbup(i) <= crb(i)) then - rbint = 1. + rbint = one else rbint = (crb(i)-rbdn(i)) / (rbup(i)-rbdn(i)) endif @@ -321,13 +322,13 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, tem = u1(i,k) - u1(i,kp1) tem1 = v1(i,k) - v1(i,kp1) tem = (tem*tem + tem1*tem1) * rdz * rdz - bvf2 = (0.5*grav)*(thvx(i,kp1)-thvx(i,k))*rdz + bvf2 = (0.5d0*grav)*(thvx(i,kp1)-thvx(i,k))*rdz & / (t1(i,k)+t1(i,kp1)) ri = max(bvf2/tem,rimin) - if(ri < 0.) then ! unstable regime - prnum(i,kp1) = 1.0 + if(ri < zero) then ! unstable regime + prnum(i,kp1) = one else - prnum(i,kp1) = min(1.0 + 2.1*ri, prmax) + prnum(i,kp1) = min(one + 2.1d0*ri, prmax) endif elseif (k > 1) then prnum(i,kp1) = prnum(i,1) @@ -437,7 +438,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for momentum ! do i=1,im - ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + ad(i,1) = one + beta(i) * stress(i) / spd1(i) a1(i,1) = u1(i,1) a2(i,1) = v1(i,1) enddo @@ -455,7 +456,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k) - au(i,k) - ad(i,kp1) = 1.0 - al(i,k) + ad(i,kp1) = one - al(i,k) a1(i,kp1) = u1(i,kp1) a2(i,kp1) = v1(i,kp1) ! @@ -482,7 +483,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for tke ! do i=1,im - ad(i,1) = 1.0 + ad(i,1) = one a1(i,1) = q1(i,1,ntke) enddo ! @@ -499,7 +500,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k) - au(i,k) - ad(i,kp1) = 1.0 - al(i,k) + ad(i,kp1) = one - al(i,k) a1(i,kp1) = q1(i,kp1,ntke) enddo enddo @@ -522,26 +523,28 @@ subroutine tridi1(l,n,cl,cm,cu,r1,au,a1) ! use machine , only : kind_phys implicit none - integer k,n,l,i - real(kind=kind_phys) fk + real(kind=kind_phys), parameter :: one=1.0d0 ! real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n), & & au(l,n-1),a1(l,n) +! + real(kind=kind_phys) fk + integer k,n,l,i ! do i=1,l - fk = 1./cm(i,1) + fk = one / cm(i,1) au(i,1) = fk*cu(i,1) a1(i,1) = fk*r1(i,1) enddo do k=2,n-1 do i=1,l - fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + fk = one / (cm(i,k)-cl(i,k)*au(i,k-1)) au(i,k) = fk*cu(i,k) a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) enddo enddo do i=1,l - fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + fk = one / (cm(i,n)-cl(i,n)*au(i,n-1)) a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) enddo do k=n-1,1,-1 diff --git a/gfsphysics/physics/rascnvv2.f b/gfsphysics/physics/rascnvv2.f index 3e70d57eb..413a1b553 100644 --- a/gfsphysics/physics/rascnvv2.f +++ b/gfsphysics/physics/rascnvv2.f @@ -9,25 +9,25 @@ module module_ras integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s integer, parameter :: idnmax=999 - real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & + real (kind=kind_phys), parameter :: delt_c=1800.0d0/3600.0d0 & ! Adjustment time scales in hrs for deep and shallow clouds ! &, adjts_d=3.0, adjts_s=0.5 ! &, adjts_d=2.5, adjts_s=0.5 - &, adjts_d=2.0, adjts_s=0.5 + &, adjts_d=2.0d0, adjts_s=0.5d0 ! logical, parameter :: fix_ncld_hr=.true. ! - real (kind=kind_phys), parameter :: ZERO=0.0, HALF=0.5 & - &, pt25=0.25 & - &, ONE=1.0, TWO=2.0, FOUR=4.& - &, twoo3=two/3.0 & - &, FOUR_P2=4.E2, ONE_M10=1.E-10 & - &, ONE_M6=1.E-6, ONE_M5=1.E-5 & - &, ONE_M2=1.E-2, ONE_M1=1.E-1 & - &, oneolog10=one/log(10.0) & - &, cfmax=0.1 & + real (kind=kind_phys), parameter :: ZERO=0.0d0, HALF=0.5d0 & + &, pt25=0.25d0, ONE=1.0d0 & + &, TWO=2.0d0, FOUR=4.0d0 & + &, twoo3=two/3.0d0 & + &, FOUR_P2=4.d2, ONE_M10=1.0d-10& + &, ONE_M6=1.0d-6, ONE_M5=1.0d-5 & + &, ONE_M2=1.0d-2, ONE_M1=1.0d-1 & + &, oneolog10=one/log(10.0d0) & + &, cfmax=0.1d0 & &, deg2rad=pi/180.d0 & ! conversion factor from degree to radians - &, cmb2pa = 100.0 ! Conversion from hPa to Pa + &, cmb2pa = 100.0d0 ! Conversion from hPa to Pa ! real(kind=kind_phys), parameter :: & & ONEBG = ONE / GRAV, GRAVCON = cmb2pa * ONEBG & @@ -36,15 +36,15 @@ module module_ras &, ELFOCP = (ALHL+ALHF) * onebcp & &, oneoalhl = one/alhl & &, CMPOR = CMB2PA / RGAS & - &, picon = half*pi*onebg, VTPEXP = -0.3636 & - &, dpnegcr = 150.0 & + &, picon = half*pi*onebg, VTPEXP = -0.3636d0 & + &, dpnegcr = 150.0d0 & ! &, dpnegcr = 100.0 & ! &, dpnegcr = 200.0 & ! &, ddunc1 = 0.4, ddunc2=one-ddunc1 & uncentering for vvel in dd - &, ddunc1 = 0.25, ddunc2=one-ddunc1 & uncentering for vvel in dd + &, ddunc1 = 0.25d0, ddunc2=one-ddunc1 & uncentering for vvel in dd ! &, ddunc1 = 0.3, ddunc2=one-ddunc1 & uncentering for vvel in dd - &, zfac = 0.28888889E-4 * ONEBG - &, c0ifac = 0.07 ! following Han et al, 2016 MWR + &, zfac = 0.28888889d-4 * ONEBG + &, c0ifac = 0.07d0 ! following Han et al, 2016 MWR ! ! logical, parameter :: advcld=.true., advups=.true., advtvd=.false. logical, parameter :: advcld=.true., advups=.false., advtvd=.true. @@ -56,16 +56,16 @@ module module_ras &, testmboalhl, testmbi ! PARAMETER (DD_DP=0.0, RKNOB=1.0, EKNOB=1.0) ! No downdraft! - PARAMETER (DD_DP=0.5, RKNOB=1.0, EKNOB=1.0) + PARAMETER (DD_DP=0.5d0, RKNOB=1.0d0, EKNOB=1.0d0) ! PARAMETER (DD_DP=0.5, RKNOB=2.0, EKNOB=1.0) ! - PARAMETER (RHMAX=1.0 ) ! MAX RELATIVE HUMIDITY - PARAMETER (QUAD_LAM=1.0) ! MASK FOR QUADRATIC LAMBDA -! PARAMETER (RHRAM=0.15) ! PBL RELATIVE HUMIDITY RAMP - PARAMETER (RHRAM=0.05) ! PBL RELATIVE HUMIDITY RAMP - PARAMETER (HCRITD=4000.0) ! Critical Moist Static Energy for Deep clouds - PARAMETER (HCRITS=2000.0) ! Critical Moist Static Energy for Shallow Clouds - PARAMETER (pcrit_lcl=250.0)! Critical pressure difference between boundary layer top + PARAMETER (RHMAX=1.0d0 ) ! MAX RELATIVE HUMIDITY + PARAMETER (QUAD_LAM=1.0d0) ! MASK FOR QUADRATIC LAMBDA +! PARAMETER (RHRAM=0.15) ! PBL RELATIVE HUMIDITY RAMP + PARAMETER (RHRAM=0.05d0) ! PBL RELATIVE HUMIDITY RAMP + PARAMETER (HCRITD=4000.0d0) ! Critical Moist Static Energy for Deep clouds + PARAMETER (HCRITS=2000.0d0) ! Critical Moist Static Energy for Shallow Clouds + PARAMETER (pcrit_lcl=250.0d0)! Critical pressure difference between boundary layer top ! and lifting condensation level (hPa) ! parameter (hpert_fac=1.01) ! Perturbation on hbl when ctei=.true. @@ -73,15 +73,15 @@ module module_ras ! parameter (hpert_fac=1.00) ! Perturbation on hbl when ctei=.true. ! parameter (qudfac=quad_lam*half, shalfac=1.0) ! parameter (qudfac=quad_lam*half, shalfac=2.0) - parameter (qudfac=quad_lam*half, shalfac=3.0) + parameter (qudfac=quad_lam*half, shalfac=3.0d0) ! parameter (qudfac=quad_lam*pt25) ! Yogesh's - parameter (testmb=0.1, testmbi=one/testmb) + parameter (testmb=0.1d0, testmbi=one/testmb) parameter (testmboalhl=testmb/alhl) ! real(kind=kind_phys) facdt - real(kind=kind_phys), parameter :: almax=1.0e-2 - &, almin1=0.0, almin2=0.0 + real(kind=kind_phys), parameter :: almax=1.0d-2 + &, almin1=0.0d0, almin2=0.0d0 ! real(kind=kind_phys) ALMIN1, ALMIN2, ALMAX ! @@ -91,7 +91,7 @@ module module_ras !cnt PARAMETER (ALMIN1=0.00E-6, ALMIN2=2.50E-5, ALMAX=5.0E-3) ! ! real(kind=kind_phys), parameter :: BLDMAX = 200.0 - real(kind=kind_phys), parameter :: BLDMAX = 300.0, bldmin=25.0 + real(kind=kind_phys), parameter :: BLDMAX = 300.0d0, bldmin=25.0d0 !! real(kind=kind_phys), parameter :: BLDMAX = 350.0 ! ! @@ -100,7 +100,7 @@ module module_ras ! parameter (TF=230.16, TCR=260.16, TCRF=1.0/(TCR-TF)) ! parameter (TF=233.16, TCR=263.16, TCRF=1.0/(TCR-TF),TCL=2.0) ! parameter (TF=258.16, TCR=273.16, TCRF=1.0/(TCR-TF),TCL=2.0) - parameter (TF=233.16, TCR=273.16, TCRF=1.0/(TCR-TF),TCL=2.0) + parameter (TF=233.16d0, TCR=273.16d0, TCRF=one/(TCR-TF),TCL=2.0d0) ! ! For Tilting Angle Specification ! @@ -127,7 +127,7 @@ subroutine set_ras_afc(dt) implicit none real(kind=kind_phys) DT ! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 - AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 + AFC = -(1.01097d-4*DT)*(3600.0d0/DT)**0.57777778d0 end subroutine set_ras_afc subroutine ras_init(levs, me) @@ -178,7 +178,7 @@ subroutine ras_init(levs, me) drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) enddo ! - VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 + VTP = 36.34d0*SQRT(1.2d0)* (0.001d0)**0.1364d0 ! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DD_DP @@ -198,12 +198,12 @@ module module_rascnv LOGICAL WRKFUN, CALKBL, CRTFUN, UPDRET, BOTOP, vsmooth, do_aw & &, CUMFRC - real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & - &, rhfacs=0.75, rhfacl=0.75 & + real(kind=kind_phys), parameter :: frac=0.5d0, crtmsf=0.0d0 & + &, rhfacs=0.75d0, rhfacl=0.75d0 & ! &, rhfacs=0.70, rhfacl=0.70 & - &, face=5.0, delx=10000.0 & - &, ddfac=face*delx*0.001 & - &, max_neg_bouy=0.15 + &, face=5.0d0, delx=10000.0d0 & + &, ddfac=face*delx*0.001d0 & + &, max_neg_bouy=0.15d0 ! &, max_neg_bouy=pt25 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -219,9 +219,9 @@ module module_rascnv ! For pressure gradient force in momentum mixing ! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & ! No pressure gradient force in momentum mixing - real (kind=kind_phys), parameter :: pgftop=0.0, pgfbot=0.0 & + real (kind=kind_phys), parameter :: pgftop=0.0d0, pgfbot=0.0d0 & ! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & - &, pgfgrad=(pgfbot-pgftop)*0.001 + &, pgfgrad=(pgfbot-pgftop)*0.001d0 ! end module module_rascnv ! @@ -306,7 +306,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & integer, dimension(100) :: ic - real(kind=kind_phys), parameter :: clwmin=1.0e-10 + real(kind=kind_phys), parameter :: clwmin=1.0d-10 ! real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) &, trcfac(:,:), rcu(:,:) @@ -431,16 +431,16 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & if (flipv) ll = kp1 -l ! Input variables are bottom to top! SGC = prsl(ipt,ll) * tem sgcs(l,ipt) = sgc - IF (SGC <= 0.050) KRMIN = L -! IF (SGC <= 0.700) KRMAX = L -! IF (SGC <= 0.800) KRMAX = L - IF (SGC <= 0.760) KRMAX = L -! IF (SGC <= 0.930) KFMAX = L - IF (SGC <= 0.970) KFMAX = L ! Commented on 20060202 -! IF (SGC <= 0.700) kblmx = L ! Commented on 20101015 - IF (SGC <= 0.600) kblmx = L ! -! IF (SGC <= 0.650) kblmx = L ! Commented on 20060202 - IF (SGC <= 0.980) kblmn = L ! + IF (SGC <= 0.050d0) KRMIN = L +! IF (SGC <= 0.700d0) KRMAX = L +! IF (SGC <= 0.800d0) KRMAX = L + IF (SGC <= 0.760d0) KRMAX = L +! IF (SGC <= 0.930d0) KFMAX = L + IF (SGC <= 0.970d0) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700d0) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600d0) kblmx = L ! +! IF (SGC <= 0.650d0) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980d0) kblmn = L ! ENDDO krmin = max(krmin,2) @@ -450,7 +450,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 - NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001d0 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 @@ -460,7 +460,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & facdt = delt_c / dt else NCRND = min(nrcmax, (KRMAX-KRMIN+1)) - facdt = one / 3600.0 + facdt = one / 3600.0d0 endif NCRND = min(nrcm,max(NCRND, 1)) ! @@ -489,7 +489,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & IF (NCRND > 0) THEN DO I=1,NCRND II = mod(i-1,nrcm) + 1 - IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) + IRND = (RANNUM(ipt,II)-0.0005d0)*(KCR-KRMIN+1) IC(KFX+I) = IRND + KRMIN ENDDO ENDIF @@ -547,7 +547,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & if (trac > 0) then ! tracers such as O3, dust etc do n=1,trac uvi(l,n) = ccin(ipt,ll,n+2) - if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero enddo endif enddo @@ -558,7 +558,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & phi_h(LL) = phii(ipt,L) enddo ! - if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -999.0d0) then ! input ice/water are together do l=1,k ll = kp1 -l tem = ccin(ipt,ll,1) & @@ -596,7 +596,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & if (trac > 0) then ! tracers such as O3, dust etc do n=1,trac uvi(l,n) = ccin(ipt,l,n+2) - if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + if (abs(uvi(l,n)) < 1.0d-20) uvi(l,n) = zero enddo endif enddo @@ -606,7 +606,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & phi_h(L) = phii(ipt,L) ENDDO ! - if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + if (ccin(ipt,1,2) <= -999.0d0) then ! input ice/water are together do l=1,k tem = ccin(ipt,l,1) & & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) @@ -664,7 +664,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*)' l=',l,' dtvd=',dtvd(:,1) - if (abs(dtvd(2,1)) > 1.0e-10) then + if (abs(dtvd(2,1)) > 1.0d-10) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h @@ -678,7 +678,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) - if (abs(dtvd(2,2)) > 1.0e-10) then + if (abs(dtvd(2,2)) > 1.0d-10) then tem1 = dtvd(1,2) / dtvd(2,2) tem2 = abs(tem1) alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q @@ -689,7 +689,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) - if (abs(dtvd(2,3)) > 1.0e-10) then + if (abs(dtvd(2,3)) > 1.0d-10) then tem1 = dtvd(1,3) / dtvd(2,3) tem2 = abs(tem1) alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql @@ -700,7 +700,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) - if (abs(dtvd(2,4)) > 1.0e-10) then + if (abs(dtvd(2,4)) > 1.0d-10) then tem1 = dtvd(1,4) / dtvd(2,4) tem2 = abs(tem1) alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi @@ -717,7 +717,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l - if (abs(dtvd(2,1)) > 1.0e-10) then + if (abs(dtvd(2,1)) > 1.0d-10) then tem1 = dtvd(1,1) / dtvd(2,1) tem2 = abs(tem1) alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers @@ -859,7 +859,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! write(0,*) ' qiiin=',qii ! endif ! - TLA = -10.0 + TLA = -10.0d0 ! qiid = qii(ib) ! cloud top level ice before convection qlid = qli(ib) ! cloud top level water before convection @@ -975,7 +975,7 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! ENDDO ! End of the NC loop! ! - RAINC(ipt) = rain * 0.001 ! Output rain is in meters + RAINC(ipt) = rain * 0.001d0 ! Output rain is in meters ! if (lprint) then ! write(0,*) ' convective precip=',rain*86400/dt,' mm/day' @@ -998,9 +998,9 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & ! clw(i) = max(clw(i), zero) ! cli(i) = max(cli(i), zero) - if (sgcs(l,ipt) < 0.93 .and. abs(tcu(l)) > one_m10) then -! if (sgcs(l,ipt) < 0.90 .and. tcu(l) .ne. 0.0) then -! if (sgcs(l,ipt) < 0.85 .and. tcu(l) .ne. 0.0) then + if (sgcs(l,ipt) < 0.93d0 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90d0 .and. tcu(l) .ne. 0.0) then +! if (sgcs(l,ipt) < 0.85d0 .and. tcu(l) .ne. 0.0) then kcnv(ipt) = 1 endif ! New test for convective clouds ! added in 08/21/96 @@ -1026,23 +1026,23 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) CNV_FICE(ipt,ll) = QICN(ipt,ll) - & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) + & / max(1.d-10,QLCN(ipt,ll)+QICN(ipt,ll)) else QLCN(ipt,ll) = qli(l) QICN(ipt,ll) = qii(l) - CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) + CNV_FICE(ipt,ll) = qii(l)/max(1.d-10,qii(l)+qli(l)) endif !! CNV_PRC3(ipt,ll) = PCU(l)/dt ! CNV_PRC3(ipt,ll) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,ll - cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ - & 500*ud_mf(ipt,ll)/dt), cfmax)) + cf_upi(ipt,ll) = max(zero,min(0.02d0*log(one+ + & 500.0d0*ud_mf(ipt,ll)/dt), cfmax)) ! & 500*ud_mf(ipt,ll)/dt), 0.60)) ! if (lprint) write(0,*)' ll=',ll,' cf_upi=',cf_upi(ipt,ll) ! &,' ud_mf=',ud_mf(ipt,ll),' dt=',dt,' cfmax=',cfmax CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / - & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) + & (dt*max(cf_upi(ipt,ll),1.d-12)*prsl(ipt,ll)) endif if (trac > 0) then @@ -1087,21 +1087,21 @@ subroutine rascnv(IM, IX, k, dt, dtf, rannum & QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) CNV_FICE(ipt,l) = QICN(ipt,l) - & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) + & / max(1.d-10,QLCN(ipt,l)+QICN(ipt,l)) else QLCN(ipt,l) = qli(l) QICN(ipt,l) = qii(l) - CNV_FICE(ipt,l) = qii(l)/max(1.e-10,qii(l)+qli(l)) + CNV_FICE(ipt,l) = qii(l)/max(1.d-10,qii(l)+qli(l)) endif !! CNV_PRC3(ipt,l) = PCU(l)/dt ! CNV_PRC3(ipt,l) = zero ! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l - cf_upi(ipt,l) = max(zero,min(0.02*log(one+ - & 500*ud_mf(ipt,l)/dt), cfmax)) + cf_upi(ipt,l) = max(zero,min(0.02d0*log(one+ + & 500.0d0*ud_mf(ipt,l)/dt), cfmax)) ! & 500*ud_mf(ipt,l)/dt), 0.60)) CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / - & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) + & (dt*max(cf_upi(ipt,l),1.d-12)*prsl(ipt,l)) endif if (trac > 0) then @@ -1152,7 +1152,7 @@ SUBROUTINE CRTWRK(PL, CCWF, ACR) real(kind=kind_phys) PL, CCWF, ACR INTEGER IWK ! - IWK = PL * 0.02 - 0.999999999 + IWK = PL * 0.02d0 - 0.999999999d0 IWK = MAX(1, MIN(IWK,16)) ACR = (AC(IWK) + PL * AD(IWK)) * CCWF ! @@ -1260,12 +1260,12 @@ SUBROUTINE CLOUD( & real(kind=kind_phys), dimension(K,NTRC) :: RCU real(kind=kind_phys) :: CUP ! - real(kind=kind_phys), parameter :: ERRMIN=0.0001 & - &, ERRMI2=0.1*ERRMIN & + real(kind=kind_phys), parameter :: ERRMIN=0.0001d0 & + &, ERRMI2=0.1d0*ERRMIN & ! &, rainmin=1.0e-9 & - &, rainmin=1.0e-8 & - &, oneopt9=1.0/0.09 & - &, oneopt4=1.0/0.04 + &, rainmin=1.0d-8 & + &, oneopt9=one/0.09d0 & + &, oneopt4=one/0.04d0 ! TEMPORARY WORK SPACE @@ -1470,7 +1470,7 @@ SUBROUTINE CLOUD( & hcrit = hcrits else hcrit = (hcrits*(sgcs(kd)-0.5d0) + hcritd*(0.65d0-sgcs(kd))) - & * (1.0d0/0.15d0) + & * (one/0.15d0) endif IF (CALKBL) THEN KTEM = MAX(KD+1, KBLMX) @@ -1556,7 +1556,7 @@ SUBROUTINE CLOUD( & ii = max(kbl,kd1) kbl = max(klcl,kd1) - tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) + tem = min(50.0d0,max(10.0d0,(prl(kmaxp1)-prl(kd))*0.10d0)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii ! if(lprnt) write(0,*)' kbl2=',kbl,' ii=',ii @@ -1627,8 +1627,8 @@ SUBROUTINE CLOUD( & ZET(KBL) = zero ! shal_fac = one -! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac - if (prl(kbl)-prl(kd) < 350.0 .and. kmax == k) shal_fac = shalfac +! if (prl(kbl)-prl(kd) < 300.0d0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0d0 .and. kmax == k) shal_fac = shalfac DO L=Kmax,KD,-1 IF (L >= KBL) THEN ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM @@ -1692,7 +1692,7 @@ SUBROUTINE CLOUD( & endif enddo ! - if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0) & + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0d0) & & return ! TX1 = RHFACS - QBL / TX1 ! Average RH @@ -1709,9 +1709,9 @@ SUBROUTINE CLOUD( & IF (.NOT. cnvflg) RETURN ! - RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0d0*TX1) )) ! - wcbase = 0.1 + wcbase = 0.1d0 if (ntrc > 0) then DO N=1,NTRC RBL(N) = ROI(Kmax,N) * ETA(Kmax) @@ -1724,9 +1724,9 @@ SUBROUTINE CLOUD( & ! ! if (ntk > 0 .and. do_aw) then if (ntk > 0) then - 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)))) + if (rbl(ntk) > zero) then + wcbase = min(2.0d0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(one, max(wcbase, sqrt(twoo3*rbl(ntk)))) endif endif @@ -1799,7 +1799,7 @@ SUBROUTINE CLOUD( & ! endif ! st1 = qil(kd) - st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) + st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1826,7 +1826,7 @@ SUBROUTINE CLOUD( & AKC(L) = one / AKT(L) ! st1 = half * (qil(l)+qil(lp1)) - st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,0.0)) + st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1898,13 +1898,13 @@ SUBROUTINE CLOUD( & HSU = HSU - ALM * TX3 ! CLP = ZERO - ALM = -100.0 + ALM = -100.0d0 HOS = HOL(KD) QOS = QOL(KD) QIS = CIL(KD) QLS = CLL(KD) - cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 + cnvflg = HBL > HSU .and. abs(tx1) > 1.0d-4 ! if (lprnt) write(0,*)' ii=',ii,' cnvflg=',cnvflg,' hsu=',hsu ! &,' hbl=',hbl,' tx1=',tx1,' hsd=',hsd @@ -1926,7 +1926,7 @@ SUBROUTINE CLOUD( & ! if (tx2 == zero) then alm = - st2 / tx1 - if (alm > almax) alm = -100.0 + if (alm > almax) alm = -100.0d0 else x00 = tx2 + tx2 epp = tx1 * tx1 - (x00+x00)*st2 @@ -1935,8 +1935,8 @@ SUBROUTINE CLOUD( & tem = sqrt(epp) tem1 = (-tx1-tem)*x00 tem2 = (-tx1+tem)*x00 - if (tem1 > almax) tem1 = -100.0 - if (tem2 > almax) tem2 = -100.0 + if (tem1 > almax) tem1 = -100.0d0 + if (tem2 > almax) tem2 = -100.0d0 alm = max(tem1,tem2) ! if (lprnt) write(0,*) ' tem1=',tem1,' tem2=',tem2,' alm=',alm @@ -2015,12 +2015,12 @@ SUBROUTINE CLOUD( & ACR = zero TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF tx1 = PRL(KBL) - TEM - tx2 = min(900.0, max(tx1,100.0)) - tem1 = log(tx2*0.01) * oneolog10 + tx2 = min(900.0d0, max(tx1,100.0d0)) + tem1 = log(tx2*0.01d0) * oneolog10 tem2 = one - tem1 if ( kdt == 1 ) then -! rel_fac = (dt * facdt) / (tem1*12.0 + tem2*3.0) - rel_fac = (dt * facdt) / (tem1*6.0 + tem2*adjts_s) +! rel_fac = (dt * facdt) / (tem1*12.0d0 + tem2*3.0d0) + rel_fac = (dt * facdt) / (tem1*6.0d0 + tem2*adjts_s) else rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) endif @@ -2241,7 +2241,7 @@ SUBROUTINE CLOUD( & ! CALCUP = .FALSE. - TEM = max(0.05, MIN(CD*200.0, MAX_NEG_BOUY)) + TEM = max(0.05d0, MIN(CD*200.0d0, MAX_NEG_BOUY)) IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. @@ -2289,7 +2289,7 @@ SUBROUTINE CLOUD( & ENDIF PL = (PRL(KD1) + PRL(KD))*HALF - IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + IF (TRAIN > 1.0d-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. ENDIF ! ! if (lprnt) then @@ -2643,7 +2643,7 @@ SUBROUTINE CLOUD( & ! sigf(kd) = max(zero, min(one, tx1 * tx1)) ! endif if (do_aw) then - tx1 = (0.2 / max(alm, 1.0e-5)) + tx1 = (0.2d0 / max(alm, 1.0d-5)) tx2 = one - min(one, pi * tx1 * tx1 / garea) ! if(lprnt) write(0,*)' kd=',kd,' alm=',alm,' tx1=',tx1 ! &,' garea=',garea,' pi=',pi,' tx2=',tx2 @@ -2795,13 +2795,13 @@ SUBROUTINE CLOUD( & endif enddo tem = tem + amb * dof * sigf(kbl) - tem = tem * (3600.0/dt) + tem = tem * (3600.0d0/dt) !!!! tem1 = max(1.0, min(100.0,sqrt((5.0E10/max(garea,one))))) ! tem1 = max(1.0, min(100.0,(7.5E10/max(garea,one)))) ! tem1 = max(1.0, min(100.0,(5.0E10/max(garea,one)))) ! tem1 = max(1.0, min(100.0,(4.0E10/max(garea,one)))) !! 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 + tem1 = sqrt(max(one, min(100.0d0,(6.25d10/max(garea,one))))) ! 20110530 ! if (lprnt) write(0,*)' clfr0=',clf(tem),' tem=',tem,' tem1=', & ! & tem1 @@ -2862,7 +2862,7 @@ SUBROUTINE CLOUD( & tem4 = zero if (tx1 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778d0 ) ) ACTEVAP = MIN(TX1, TEM4*CLFRAC) ! if(lprnt) write(0,*)' L=',L,' actevap=',actevap,' tem4=',tem4, @@ -2873,7 +2873,7 @@ SUBROUTINE CLOUD( & ! tem4 = zero if (tx2 > zero) & - & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778d0 ) ) TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) ! @@ -2946,7 +2946,7 @@ SUBROUTINE CLOUD( & ! following Liu et al. [JGR,2001] Eq 1 if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001) + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001d0) FNOSCAV = exp(- FSCAV_(N) * DELZKM) else FNOSCAV = one @@ -2956,7 +2956,7 @@ SUBROUTINE CLOUD( & & * FNOSCAV DO L=KD1,K if (FSCAV_(N) > zero) then - DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001) + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001d0) FNOSCAV = exp(- FSCAV_(N) * DELZKM) endif lm1 = l - 1 @@ -3097,7 +3097,7 @@ SUBROUTINE DDRFT( & ! integer, parameter :: NUMTLA=2 ! integer, parameter :: NUMTLA=4 - parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) + parameter (ERRMIN=0.0001d0, ERRMI2=0.1d0*ERRMIN) ! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) ! real (kind=kind_phys), parameter :: PIINV=one/PI @@ -3108,8 +3108,9 @@ SUBROUTINE DDRFT( & ! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) ! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) ! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) - PARAMETER (AA1=1.0, BB1=1.0, CC1=1.0, DD1=1.0, F3=CC1, F5=1.0) - parameter (QRMIN=1.0E-6, WC2MIN=0.01, GMF1=GMF/AA1, GMF5=GMF/F5) + PARAMETER (AA1=1.0d0, BB1=1.0d0, CC1=1.0d0, DD1=1.0d0, & + & F3=CC1, F5=1.0d0) + parameter (QRMIN=1.0d-6, WC2MIN=0.01d0, GMF1=GMF/AA1, GMF5=GMF/F5) ! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) parameter (WCMIN=sqrt(wc2min)) ! parameter (sialf=0.5) @@ -3146,7 +3147,7 @@ SUBROUTINE DDRFT( & CLDFRD = zero RNTP = zero DOF = zero - ERRQ = 10.0 + ERRQ = 10.0d0 RNB = zero RNT = zero TX2 = PRL(KBL) @@ -3177,7 +3178,7 @@ SUBROUTINE DDRFT( & ENDDO if (kk /= kbl) then do l=kk,kbl - buy(l) = 0.9 * buy(l-1) + buy(l) = 0.9d0 * buy(l-1) enddo endif ! @@ -3185,24 +3186,24 @@ SUBROUTINE DDRFT( & qrpi(l) = buy(l) enddo do l=kd1,kb1 - buy(l) = 0.25 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + buy(l) = 0.25d0 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) enddo ! ! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) - tx1 = 1000.0 + tx1 - prl(kp1) + tx1 = 1000.0d0 + tx1 - prl(kp1) ! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) CALL ANGRAD(TX1, ALM, AL2, TLA) ! ! Following Ucla approach for rain profile ! - F2 = (BB1+BB1)*ONEBG/(PI*0.2) + F2 = (BB1+BB1)*ONEBG/(PI*0.2d0) ! WCMIN = SQRT(WC2MIN) ! WCBASE = WCMIN ! ! del_tla = TLA * 0.2 ! del_tla = TLA * 0.25 - del_tla = TLA * 0.3 + del_tla = TLA * 0.3d0 TLA = TLA - DEL_TLA ! DO L=KD,K @@ -3263,7 +3264,7 @@ SUBROUTINE DDRFT( & do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries ! ------ ! if (errq < 1.0 .or. tla > 45.0) cycle - if (errq < 0.1 .or. tla > 45.0) cycle + if (errq < 0.1d0 .or. tla > 45.0d0) cycle ! tla = tla + del_tla STLA = SIN(TLA*deg2rad) ! sine of tilting angle @@ -3273,9 +3274,9 @@ SUBROUTINE DDRFT( & ! &,0.5*(prl(kd)+prl(kd1)),' ntla=',ntla,' f2=',f2,' stla=',stla ! if (lprnt) write(0,*)' buy=',(buy(l),l=kd,kbl) ! - STLA = F2 * STLA * AL2 - CTL2 = DD1 * CTL2 - CTL3 = 0.1364 * CTL2 + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364d0 * CTL2 ! DO L=KD,K RNF(L) = zero @@ -3351,7 +3352,7 @@ SUBROUTINE DDRFT( & VRW(1) = F3*WVL(KD) - CTL2*VT(1) BUD(KD) = STLA * TX6 * QRB(KD) * half RNF(KD) = BUD(KD) - DOF = 1.1364 * BUD(KD) * QRPI(KD) + DOF = 1.1364d0 * BUD(KD) * QRPI(KD) DOFW = -BUD(KD) * STLT(KD) ! RNT = TRW(1) * VRW(1) @@ -3385,7 +3386,7 @@ SUBROUTINE DDRFT( & ! QA(2) = DOF WA(2) = DOFW - DOF = 1.1364 * BUD(L) * QRPI(L) + DOF = 1.1364d0 * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + QQQ * ST1 @@ -3456,7 +3457,7 @@ SUBROUTINE DDRFT( & QA(2) = DOF WA(2) = DOFW - DOF = 1.1364 * BUD(L) * QRPI(L) + DOF = 1.1364d0 * BUD(L) * QRPI(L) DOFW = -BUD(L) * STLT(L) ! RNF(LL) = RNF(LL) + ST1 @@ -3597,7 +3598,7 @@ SUBROUTINE DDRFT( & ENDDO ! ! tem = 0.5 - if (tx2 > one .and. abs(errq-tx2) > 0.1) then + if (tx2 > one .and. abs(errq-tx2) > 0.1d0) then tem = half !! elseif (tx2 < 0.1) then !! tem = 1.2 @@ -3625,18 +3626,18 @@ SUBROUTINE DDRFT( & ELSE TEM = ERRQ - TX2 ! IF (TEM < ZERO .AND. ERRQ > 0.1) THEN - IF (TEM < ZERO .AND. ERRQ > 0.5) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5d0) THEN ! IF (TEM < ZERO .and. & ! & (ntla < numtla .or. ERRQ > 0.5)) THEN ! if (lprnt) write(0,*)' tx2=',tx2,' errq=',errq,' tem=',tem SKPUP = .TRUE. ! No convergence ! - ERRQ = 10.0 ! No rain profile! + ERRQ = 10.0d0 ! No rain profile! !!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN ELSEIF (TX2 < ERRMIN) THEN SKPUP = .TRUE. ! Converges ! ERRQ = zero ! Rain profile exists! ! if (lprnt) write(0,*)' here2' - elseif (tem < zero .and. errq < 0.1) then + elseif (tem < zero .and. errq < 0.1d0) then skpup = .true. ! if (ntla == numtla .or. tem > -0.003) then errq = zero @@ -3663,7 +3664,7 @@ SUBROUTINE DDRFT( & ! &,' errq=',errq ! endif ! - IF (ERRQ < 0.1) THEN + IF (ERRQ < 0.1d0) THEN DDFT = .TRUE. RNB = - RNB ! do l=kd1,kb1-1 @@ -3686,7 +3687,7 @@ SUBROUTINE DDRFT( & ! if (lprnt) write(0,*)' tx1+rnt+rnb=',tx1+rnt+rnb, ' train=',train TX1 = TRAIN / (TX1+RNT+RNB) ! if (lprnt) write(0,*)' tx1= ', tx1 - IF (ABS(TX1-one) < 0.2) THEN + IF (ABS(TX1-one) < 0.2d0) THEN RNT = MAX(RNT*TX1,ZERO) RNB = RNB * TX1 DO L=KD,KB1 @@ -3699,7 +3700,7 @@ SUBROUTINE DDRFT( & ELSE DDFT = .FALSE. - ERRQ = 10.0 + ERRQ = 10.0d0 ENDIF ENDIF ! @@ -3724,7 +3725,7 @@ SUBROUTINE DDRFT( & WCB(L) = zero ENDDO ! - ERRQ = 10.0 + ERRQ = 10.0d0 ! At this point stlt contains inverse of updraft vertical velocity 1/Wu. KK = MAX(KB1,KD1) @@ -3774,9 +3775,9 @@ SUBROUTINE DDRFT( & IF (RNT > zero) THEN if (TX1 > zero) THEN QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & - & ** (one/1.1364) + & ** (one/1.1364d0) else - tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364) + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364d0) endif RNTP = (one - RPART) * RNT BUY(KD) = - ROR(KD) * TX1 * QRP(KD) @@ -3840,7 +3841,7 @@ SUBROUTINE DDRFT( & VRW(1) = half * (GAM(L-1) + GAM(L)) VRW(2) = one / (VRW(1) + VRW(1)) ! - TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.00*EKNOB) + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.0d0*EKNOB) ! DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! ! @@ -3848,7 +3849,7 @@ SUBROUTINE DDRFT( & HOD(L) = HOD(L-1) QOD(L) = QOD(L-1) ! - ERRQ = 10.0 + ERRQ = 10.0d0 ! IF (L <= KBL) THEN @@ -3873,7 +3874,7 @@ SUBROUTINE DDRFT( & IF (L == KD1) THEN IF (RNT > zero) THEN TEM = MAX(QRP(L-1),QRP(L)) - WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0d0) ENDIF WVL(L) = MAX(ONE_M2, WVL(L)) TRW(1) = TRW(1) * half @@ -4019,9 +4020,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 ! - CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) @@ -4032,7 +4033,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6 * ST2 / ((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -4056,7 +4057,7 @@ SUBROUTINE DDRFT( & QRP(L) = MAX(TEM,ZERO) ELSEIF (TX5 > zero) THEN QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ELSE QRP(L) = zero ENDIF @@ -4092,7 +4093,7 @@ SUBROUTINE DDRFT( & ! WVL(L) = 0.5*tem1 ! WVL(L) = 0.1*tem1 ! WVL(L) = 0.0 - WVL(L) = 1.0e-10 + WVL(L) = 1.0d-10 else WVL(L) = half*(WVL(L)+TEM1) endif @@ -4116,7 +4117,7 @@ SUBROUTINE DDRFT( & ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN ! if(lprnt) write(0,*)' itr=',itr,' etd1=',etd(l-1),' errq=',errq - IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2d0) THEN ! if(lprnt) write(0,*)' bud=',bud(kd),' wa=',wa(1),wa(2) ROR(L) = BUD(KD) ETD(L) = zero @@ -4129,7 +4130,7 @@ SUBROUTINE DDRFT( & TX5 = TX9 else TX5 = (STLT(KB1) * QRT(KB1) & - & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) + & + STLT(KBL) * QRB(KB1)) * (0.5d0*FAC) endif ! if(lprnt) write(0,*)' tx1=',tx1,' rnt=',rnt,' rnf=',rnf(l-1) @@ -4151,14 +4152,14 @@ SUBROUTINE DDRFT( & ! *,' errq=',errq QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ! endif BUY(L) = - ROR(L) * TX5 * QRP(L) WCB(L-1) = zero ENDIF ! DEL_ETA = ETD(L) - ETD(L-1) - IF(DEL_ETA < zero .AND. ERRQ > 0.1) THEN + IF(DEL_ETA < zero .AND. ERRQ > 0.1d0) THEN ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -4185,9 +4186,9 @@ SUBROUTINE DDRFT( & ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) TEM2 = ROR(L) * QRP(L-1) CALL QRABF(TEM2,QRAF,QRBF) - TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 + TEM6 = TX5 * (1.6d0 + 124.9d0 * QRAF) * QRBF * TX4 ! - CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) @@ -4198,7 +4199,7 @@ SUBROUTINE DDRFT( & ! second iteration ! ! ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) - CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) + CE = TEM6*ST2/((5.4d5*ST2 + 2.55d6)*(ETD(L)+DDZ)) ! CEE = CE * (ETD(L)+DDZ) ! @@ -4258,7 +4259,8 @@ SUBROUTINE DDRFT( & ! ENDDO ! End of the iteration loop for a given L! IF (L <= K) THEN - IF (ETD(L-1) == zero .AND. ERRQ > 0.1 .and. l <= kbl) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1d0 .and. & + & l <= kbl) THEN !!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN ! & .AND. ERRQ > ERRMIN*10.0) THEN ROR(L) = BUD(KD) @@ -4281,7 +4283,7 @@ SUBROUTINE DDRFT( & ! IF (QA(1) > 0.0) THEN QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & - & ** (one/1.1364) + & ** (one/1.1364d0) ! ENDIF ETD(L) = zero WVL(L) = zero @@ -4318,7 +4320,7 @@ SUBROUTINE DDRFT( & ! not converge) , no downdraft is assumed ! ! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & - IF (ERRQ > 0.1 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. + IF (ERRQ > 0.1d0 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. ! DOF = zero IF (.NOT. DDFT) RETURN @@ -4423,18 +4425,18 @@ SUBROUTINE QSATCN(TT,P,Q,DQDT) ! real(kind=kind_phys) TT, P, Q, DQDT ! - real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & - &, ONE_M10=1.E-10 & + real(kind=kind_phys), parameter :: ZERO=0.0d0, ONE=1.0d0 & + &, ONE_M10=1.0d-10 & &, rvi=one/rv, facw=CVAP-CLIQ & &, faci=CVAP-CSOL, hsub=HVAP+HFUS & - &, tmix=TTP-20.0 & + &, tmix=TTP-20.0d0 & &, DEN=one/(TTP-TMIX) ! logical lprnt ! real(kind=kind_phys) es, d, hlorv, W ! -! es = 10.0 * fpvs(tt) ! fpvs is in centibars! - es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! +! es = 10.0 * fpvs(tt) ! fpvs is in centibars! + es = min(p, 0.01d0 * fpvs(tt)) ! fpvs is in Pascals! ! D = one / max(p+epsm1*es,ONE_M10) D = one / (p+epsm1*es) ! @@ -4457,7 +4459,7 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) ! integer i ! - IF (TLA < 0.0) THEN + IF (TLA < 0.0d0) THEN IF (PRES <= PLAC(1)) THEN TLA = TLAC(1) ELSEIF (PRES <= PLAC(2)) THEN @@ -4494,8 +4496,8 @@ SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) TEM = REFR(6) ENDIF ! - tem = 2.0E-4 / tem - al2 = min(4.0*tem, max(alm, tem)) + tem = 2.0d-4 / tem + al2 = min(4.0d0*tem, max(alm, tem)) ! RETURN END @@ -4508,18 +4510,18 @@ SUBROUTINE SETQRP integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! XMIN = 1.0E-6 - XMIN = 0.0 - XMAX = 5.0 + XMIN = 0.0d0 + XMAX = 5.0d0 XINC = (XMAX-XMIN)/(NQRP-1) C2XQRP = one / XINC C1XQRP = one - XMIN*C2XQRP - TEM1 = 0.001 ** 0.2046 - TEM2 = 0.001 ** 0.525 + TEM1 = 0.001d0 ** 0.2046d0 + TEM2 = 0.001d0 ** 0.525d0 DO JX=1,NQRP X = XMIN + (JX-1)*XINC - TBQRP(JX) = X ** 0.1364 - TBQRA(JX) = TEM1 * X ** 0.2046 - TBQRB(JX) = TEM2 * X ** 0.525 + TBQRP(JX) = X ** 0.1364d0 + TBQRA(JX) = TEM1 * X ** 0.2046d0 + TBQRB(JX) = TEM2 * X ** 0.525d0 ENDDO ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN @@ -4566,8 +4568,8 @@ SUBROUTINE SETVTP real(kind=kind_phys) xinc,x,xmax,xmin integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - XMIN = 0.05 - XMAX = 1.5 + XMIN = 0.05d0 + XMAX = 1.5d0 XINC = (XMAX-XMIN)/(NVTP-1) C2XVTP = one / XINC C1XVTP = one - XMIN*C2XVTP @@ -4599,10 +4601,10 @@ FUNCTION CLF(PRATE) implicit none real(kind=kind_phys) PRATE, CLF ! - real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & - &, ccf3=0.04, ccf4=0.01 & - &, pr1=1.0, pr2=5.0 & - &, pr3=20.0 + real (kind=kind_phys), parameter :: ccf1=0.30d0, ccf2=0.09d0 & + &, ccf3=0.04d0, ccf4=0.01d0 & + &, pr1=1.0d0, pr2=5.0d0 & + &, pr3=20.0d0 ! if (prate < pr1) then clf = ccf1 diff --git a/gfsphysics/physics/sfc_drv.f b/gfsphysics/physics/sfc_drv.f index bd1ad4f5f..7f3a104b4 100644 --- a/gfsphysics/physics/sfc_drv.f +++ b/gfsphysics/physics/sfc_drv.f @@ -170,15 +170,15 @@ subroutine sfc_drv & real(kind=kind_phys), parameter :: cpinv = one/cp real(kind=kind_phys), parameter :: hvapi = one/hvap real(kind=kind_phys), parameter :: elocp = hvap/cp - real(kind=kind_phys), parameter :: rhoh2o = 1000.0 - real(kind=kind_phys), parameter :: a2 = 17.2693882 - real(kind=kind_phys), parameter :: a3 = 273.16 - real(kind=kind_phys), parameter :: a4 = 35.86 + real(kind=kind_phys), parameter :: rhoh2o = 1000.0d0 + real(kind=kind_phys), parameter :: a2 = 17.2693882d0 + real(kind=kind_phys), parameter :: a3 = 273.16d0 + real(kind=kind_phys), parameter :: a4 = 35.86d0 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) real(kind=kind_phys), parameter :: qmin = 1.0d-8 real(kind=kind_phys), save :: zsoil_noah(4) - data zsoil_noah / -0.1, -0.4, -1.0, -2.0 / + data zsoil_noah / -0.1d0, -0.4d0, -1.0d0, -2.0d0 / ! --- input: integer, intent(in) :: im, km, isot, ivegsrc diff --git a/gfsphysics/physics/sfc_ocean.f b/gfsphysics/physics/sfc_ocean.f index a1cf2c902..ad18899fc 100644 --- a/gfsphysics/physics/sfc_ocean.f +++ b/gfsphysics/physics/sfc_ocean.f @@ -67,17 +67,14 @@ subroutine sfc_ocean & ! use machine , only : kind_phys use funcphys, only : fpvs - use physcons, only : cp => con_cp, rd => con_rd, eps => con_eps, & - & epsm1 => con_epsm1, hvap => con_hvap, & - & rvrdm1 => con_fvirt + use physcons, only : rd => con_rd, eps => con_eps, & + & epsm1 => con_epsm1, rvrdm1 => con_fvirt ! implicit none ! ! --- constant parameters: - real (kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 & - &, cpinv = one/cp & - &, hvapi = one/hvap & - &, elocp = hvap/cp, qmin = 1.0d-8 + real (kind=kind_phys), parameter :: one = 1.0d0, zero = 0.0d0 & + &, qmin = 1.0d-8 ! --- inputs: integer, intent(in) :: im @@ -94,22 +91,18 @@ subroutine sfc_ocean & ! --- locals: real (kind=kind_phys) :: q0, qss, rho, tem - - integer :: i - - logical :: flag(im) + integer :: i ! !===> ... begin here ! -! --- ... flag for open water do i = 1, im - flag(i) = (wet(i) .and. flag_iter(i)) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface - if ( flag(i) ) then + if (wet(i) .and. flag_iter(i)) then + q0 = max(q1(i), qmin) rho = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0)) From a2b883ba986a0fef40e93c2ea11ea19b9265d6f0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 18 Apr 2020 23:56:27 +0000 Subject: [PATCH 037/217] some bug fix in ras and mg3 and make constants douple precision --- ccpp/framework | 2 +- gfsphysics/physics/gcm_shoc.f90 | 6 ++-- gfsphysics/physics/m_micro_driver.F90 | 44 +++++++++++++-------------- gfsphysics/physics/micro_mg_utils.F90 | 8 ++--- gfsphysics/physics/moninshoc.f | 4 +-- gfsphysics/physics/rascnvv2.f | 2 +- gfsphysics/physics/sfc_diff.f | 8 ++--- gfsphysics/physics/sfc_drv.f | 4 +-- gfsphysics/physics/sfc_sice.f | 10 +++--- 9 files changed, 44 insertions(+), 44 deletions(-) diff --git a/ccpp/framework b/ccpp/framework index d32b965b1..4b9cd89b4 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit d32b965b11882a42d9db522dc13823b7720b63aa +Subproject commit 4b9cd89b4fbbd9dfbee98af3491d5fc0e55bbadf diff --git a/gfsphysics/physics/gcm_shoc.f90 b/gfsphysics/physics/gcm_shoc.f90 index fa6133899..6916dd96a 100644 --- a/gfsphysics/physics/gcm_shoc.f90 +++ b/gfsphysics/physics/gcm_shoc.f90 @@ -968,7 +968,7 @@ subroutine check_eddy() do i=1,nx - wrk = 0.1*adzl(i,k) + wrk = 0.1d0*adzl(i,k) ! Minimum 0.1 of local dz smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) @@ -1249,7 +1249,7 @@ subroutine assumed_pdf() ELSE !aab @@ -1574,7 +1574,6 @@ subroutine assumed_pdf() ! ,' hl=',hl(i,k),' gamaz=',gamaz(i,k),' diag_ql=',diag_ql,' qpl=',qpl(i,k)& ! ,' diag_qi=',diag_qi,' qpi=',qpi(i,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& ! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 -! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 ! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) @@ -1593,6 +1592,7 @@ subroutine assumed_pdf() endif endif +! Update moisture fields qc(i,k) = diag_ql qi(i,k) = diag_qi qwv(i,k) = max(zero, total_water(i,k) - diag_qn) diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 07979a810..87e88046a 100644 --- a/gfsphysics/physics/m_micro_driver.F90 +++ b/gfsphysics/physics/m_micro_driver.F90 @@ -312,7 +312,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & DO K=0, LM ll = lm-k DO I = 1,IM - PLE(i,k) = prsi_i(i,ll) *0.01d0 ! interface pressure in hPa + PLE(i,k) = prsi_i(i,ll) * 0.01d0 ! interface pressure in hPa zet(i,k+1) = phii(i,ll) * onebg END DO END DO @@ -526,11 +526,11 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & do L=LM,1,-1 do i=1,im blk_l(i,l) = one / (one/max(0.15d0*ZPBL(i),0.4d0*zlo(i,lm-1))& - & + one/(zlo(i,l)*.4d0) ) + & + one/(zlo(i,l)*0.4d0) ) SC_ICE(i,l) = one - NCPL(i,l) = MAX( NCPL(i,l), 0.0d0) - NCPI(i,l) = MAX( NCPI(i,l), 0.0d0) + NCPL(i,l) = MAX( NCPL(i,l), zero) + NCPI(i,l) = MAX( NCPI(i,l), zero) RAD_CF(i,l) = max(zero, min(CLLS(i,l)+CLCN(i,l), one)) if (.not. iccn) then CDNC_NUC(i,l) = zero @@ -647,7 +647,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! rad_cooling(k) = RADheat(I,k) if (npre8(k) > zero .and. qir8(k) > zero) then - dpre8(k) = ( qir8(k)/(6.0*npre8(k)*900.0d0*PI))**(one/3.0d0) + dpre8(k) = ( qir8(k)/(6.0d0*npre8(k)*900.0d0*PI))**(one/3.0d0) else dpre8(k) = 1.0d-9 endif @@ -813,7 +813,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & smaxicer8(K) = zero nheticer8(K) = zero sc_icer8(K) = 2.0d0 -! sc_icer8(K) = 1.0 +! sc_icer8(K) = 1.0d0 naair8(K) = zero npccninr8(K) = zero nlimicer8(K) = zero @@ -840,13 +840,13 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & ! if(temp(i,k) < T_ICE_ALL) then ! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5d0) elseif(temp(i,k) > TICE) then SC_ICE(i,k) = rhc(i,k) else ! SC_ICE(i,k) = 1.0 ! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5) + tx1 = max(SC_ICE(I,k), 1.5d0) SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & * t_ice_denom endif @@ -1272,7 +1272,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0), 150.0d0) CLDREFFI(I,k) = min(max(effir8(k), 20.0d0), 150.0d0) - CLDREFFR(I,k) = max(droutr8(k)*0.5*1.0d6, 150.0d0) + CLDREFFR(I,k) = max(droutr8(k)*0.5d0*1.0d6, 150.0d0) CLDREFFS(I,k) = max(0.192d0*dsoutr8(k)*0.5d0*1.0d6, 250.0d0) enddo ! K loop @@ -1355,8 +1355,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & & lev_sed_strt) ! - LS_PRC2(I) = max(1000.d0*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.d0*precir8(1), zero) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1371,7 +1371,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & NCPS(I,k) = max(NCPS(I,k) + nstend(k)*dt_r8, zero) CLDREFFL(I,k) = min(max(effcr8(k), 10.0d0),150.0d0) - CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),1500.0d0) + CLDREFFI(I,k) = min(max(effir8(k), 20.0d0),150.0d0) CLDREFFR(I,k) = max(reff_rain(k),150.0d0) CLDREFFS(I,k) = max(reff_snow(k),250.0d0) enddo ! K loop @@ -1491,8 +1491,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & & lev_sed_strt) - LS_PRC2(I) = max(1000.d0*(prectr8(1)-precir8(1)), zero) - LS_SNR(I) = max(1000.d0*precir8(1), zero) + LS_PRC2(I) = max(1000.0d0*(prectr8(1)-precir8(1)), zero) + LS_SNR(I) = max(1000.0d0*precir8(1), zero) do k=1,lm QL_TOT(I,k) = QL_TOT(I,k) + qctendr8(k)*DT_R8 QI_TOT(I,k) = QI_TOT(I,k) + qitendr8(k)*DT_R8 @@ -1523,8 +1523,8 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & LS_PRC2(I) = zero LS_SNR(I) = zero do k=1,lm - CLDREFFL(I,k) = 100.0d0 - CLDREFFI(I,k) = 500.0d0 + CLDREFFL(I,k) = 10.0d0 + CLDREFFI(I,k) = 50.0d0 CLDREFFR(I,k) = 1000.0d0 CLDREFFS(I,k) = 250.0d0 CLDREFFG(I,k) = 250.0d0 @@ -1766,7 +1766,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & real(kind=kind_phys), intent(out) :: nm(pcols,pver) real(kind=kind_phys), parameter :: r=rgas, cpair=cp, g=grav, & - oneocp=1.0/cp, n2min=1.e-8 + oneocp=1.0d0/cp, n2min=1.0d-8 !---------------------------Local storage------------------------------- integer :: ix,kx @@ -1782,15 +1782,15 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = 0 do ix = 1, ncol ti(ix,kx) = t(ix,kx+1) - rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0+fv*sph(ix,kx+1)))) + rhoi(ix,kx) = pi(ix,kx) / (r*(ti(ix,kx)*(1.0d0+fv*sph(ix,kx+1)))) ni(ix,kx) = sqrt (g*g / (cpair*ti(ix,kx))) end do ! Interior points use centered differences do kx = 1, pver-1 do ix = 1, ncol - ti(ix,kx) = 0.5 * (t(ix,kx) + t(ix,kx+1)) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0+0.5*fv*(sph(ix,kx)+sph(ix,kx+1)))) + ti(ix,kx) = 0.5d0 * (t(ix,kx) + t(ix,kx+1)) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+0.5d0*fv*(sph(ix,kx)+sph(ix,kx+1)))) dtdp = (t(ix,kx+1)-t(ix,kx)) / (pm(ix,kx+1)-pm(ix,kx)) n2 = g*g/ti(ix,kx) * (oneocp - rhoi(ix,kx)*dtdp) ni(ix,kx) = sqrt (max (n2min, n2)) @@ -1802,7 +1802,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & kx = pver do ix = 1, ncol ti(ix,kx) = t(ix,kx) - rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0+fv*sph(ix,kx))) + rhoi(ix,kx) = pi(ix,kx) / (r*ti(ix,kx)*(1.0d0+fv*sph(ix,kx))) ni(ix,kx) = ni(ix,kx-1) end do @@ -1811,7 +1811,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & !----------------------------------------------------------------------------- do kx=1,pver do ix=1,ncol - nm(ix,kx) = 0.5 * (ni(ix,kx-1) + ni(ix,kx)) + nm(ix,kx) = 0.5d0 * (ni(ix,kx-1) + ni(ix,kx)) end do end do diff --git a/gfsphysics/physics/micro_mg_utils.F90 b/gfsphysics/physics/micro_mg_utils.F90 index 53518bef7..ffd13c2d5 100644 --- a/gfsphysics/physics/micro_mg_utils.F90 +++ b/gfsphysics/physics/micro_mg_utils.F90 @@ -488,7 +488,7 @@ elemental subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc xs = max(min(xs, 1.7_r8), 1.1_r8) xs = xs*xs*xs - xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.)/8.0_r8 + xs = (xs + sqrt(xs+8.0_r8)*sqrt(xs) - 4.0_r8)/8.0_r8 pgam = sqrt(xs) else @@ -705,8 +705,8 @@ elemental subroutine size_dist_param_ice_line(props, qic, nic, lam, n0) lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim) if (ice_sep) then miu_ice = max(min(0.008_r8*(lam*0.01)**0.87_r8, 10.0_r8), 0.1_r8) - tx1 = 1. + miu_ice - tx2 = 1. / gamma(tx1) + tx1 = 1.0_r8 + miu_ice + tx2 = 1.0_r8 / gamma(tx1) aux = (gamma(tx1+3.0_r8)*tx2) ** (1.0_r8/3.0_r8) lam = lam*aux else @@ -1101,7 +1101,7 @@ subroutine liu_liq_autoconversion(pgam,qc,nc,qr,rho,relvar, & beta6 = (one+three*xs)*(one+four*xs)*(one+five*xs) & / ((one+xs)*(one+xs+xs)) LW = 1.0e-3_r8 * qc(i) * rho(i) - NW = nc(i) * rho(i) * 1.e-6_r8 + NW = nc(i) * rho(i) * 1.e-6_r8 xs = min(20.0_r8, 1.03e16_r8*(LW*LW)/(NW*SQRT(NW))) au(i) = 1.1e10_r8*beta6*LW*LW*LW & diff --git a/gfsphysics/physics/moninshoc.f b/gfsphysics/physics/moninshoc.f index 20a2adccc..c0926631a 100644 --- a/gfsphysics/physics/moninshoc.f +++ b/gfsphysics/physics/moninshoc.f @@ -347,7 +347,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! compute tridiagonal matrix elements for heat and moisture ! do i=1,im - ad(i,1) = 1. + ad(i,1) = one a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo @@ -381,7 +381,7 @@ subroutine moninshoc(ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, al(i,k) = -dtodsu*dsdz2 ! ad(i,k) = ad(i,k)-au(i,k) - ad(i,kp1) = 1.-al(i,k) + ad(i,kp1) = one - al(i,k) dsdzt = tem1 * gocp a1(i,k) = a1(i,k) + dtodsd*dsdzt a1(i,kp1) = t1(i,kp1) - dtodsu*dsdzt diff --git a/gfsphysics/physics/rascnvv2.f b/gfsphysics/physics/rascnvv2.f index 413a1b553..2a17b8ca5 100644 --- a/gfsphysics/physics/rascnvv2.f +++ b/gfsphysics/physics/rascnvv2.f @@ -1725,7 +1725,7 @@ SUBROUTINE CLOUD( & ! if (ntk > 0 .and. do_aw) then if (ntk > 0) then if (rbl(ntk) > zero) then - wcbase = min(2.0d0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + wcbase = min(two, max(wcbase, sqrt(twoo3*rbl(ntk)))) ! wcbase = min(one, max(wcbase, sqrt(twoo3*rbl(ntk)))) endif endif diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index a1dc3e8af..c59a9b851 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -2,7 +2,7 @@ module module_sfc_diff use machine , only : kind_phys use physcons, grav => con_g - real (kind=kind_phys), parameter :: ca=.4 ! ca - von karman constant + real (kind=kind_phys), parameter :: ca=0.4d0 ! ca - von karman constant contains subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) @@ -86,7 +86,7 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) do i=1,im if(flag_iter(i)) then - virtfac = 1.0 + rvrdm1 * max(q1(i),qmin) + virtfac = one + rvrdm1 * max(q1(i),qmin) thv1 = t1(i) * prslki(i) * virtfac ! compute stability dependent exchange coefficients @@ -150,7 +150,7 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land if (ztpert(i) /= zero) then - ztmax = ztmax * (10.d0**ztpert(i)) + ztmax = ztmax * (10.0d0**ztpert(i)) endif ztmax = max(ztmax, zmin) ! @@ -297,7 +297,7 @@ subroutine stability ! --- locals: real(kind=kind_phys), parameter :: alpha=5.0d0, a0=-3.975d0 & - &, a1=12.32d0, alpha4=4.0d0*alpha + &, a1=12.32d0, alpha4=4.0d0*alpha & &, b1=-7.755d0, b2=6.041d0, alpha2=alpha+alpha & &, beta=1.0d0 & &, a0p=-7.941d0, a1p=24.75d0, b1p=-8.705d0, b2p=7.899d0& diff --git a/gfsphysics/physics/sfc_drv.f b/gfsphysics/physics/sfc_drv.f index 7f3a104b4..84b4b84d5 100644 --- a/gfsphysics/physics/sfc_drv.f +++ b/gfsphysics/physics/sfc_drv.f @@ -175,7 +175,7 @@ subroutine sfc_drv & real(kind=kind_phys), parameter :: a3 = 273.16d0 real(kind=kind_phys), parameter :: a4 = 35.86d0 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) - real(kind=kind_phys), parameter :: qmin = 1.0d-8 + real(kind=kind_phys), parameter :: qmin = 1.0d-8 real(kind=kind_phys), save :: zsoil_noah(4) data zsoil_noah / -0.1d0, -0.4d0, -1.0d0, -2.0d0 / @@ -510,7 +510,7 @@ subroutine sfc_drv & sncovr1(i) = sncovr ! ---- ... outside sflx, roughness uses cm as unit (update after snow's ! effect) - zorl(i) = z0*100.d0 + zorl(i) = z0*100.0d0 ! --- ... do not return the following output fields to parent model ! ec - canopy water evaporation (m s-1) diff --git a/gfsphysics/physics/sfc_sice.f b/gfsphysics/physics/sfc_sice.f index bf5dbbaf3..edb8034fe 100644 --- a/gfsphysics/physics/sfc_sice.f +++ b/gfsphysics/physics/sfc_sice.f @@ -191,7 +191,7 @@ subroutine sfc_sice & if (flag(i)) then if (srflag(i) > zero) then ep(i) = ep(i)*(one-srflag(i)) - weasd(i) = weasd(i) + 1.e3*tprcp(i)*srflag(i) + weasd(i) = weasd(i) + 1.0d3*tprcp(i)*srflag(i) tprcp(i) = tprcp(i)*(one-srflag(i)) endif endif @@ -449,7 +449,7 @@ subroutine ice3lay real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di real (kind=kind_phys), parameter :: ci = 2054.0d0 ! heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34e5 ! latent heat of fusion (j/kg-ice) + real (kind=kind_phys), parameter :: li = 3.34d5 ! latent heat of fusion (j/kg-ice) real (kind=kind_phys), parameter :: si = 1.0d0 ! salinity of sea ice real (kind=kind_phys), parameter :: mu = 0.054d0 ! relates freezing temp to salinity real (kind=kind_phys), parameter :: tfi = -mu*si ! sea ice freezing temp = -mu*salinity @@ -492,9 +492,9 @@ subroutine ice3lay ! !===> ... begin here ! - dt2 = 2.0d0 * delt - dt4 = 4.0d0 * delt - dt6 = 6.0d0 * delt + dt2 = delt + delt + dt4 = dt2 + dt2 + dt6 = dt2 + dt4 dt2i = one / dt2 do i = 1, im From a729847e6f3c253befa9a3c81cc26ec9c5b50f11 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Apr 2020 17:55:19 +0000 Subject: [PATCH 038/217] adding OMP directives to some loops plus using _kind_phys in atmos_model.F90 --- atmos_model.F90 | 30 +++++++++++++++++++----------- ccpp/physics | 2 +- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index e97935fe7..b978c2a71 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -895,7 +895,7 @@ subroutine update_atmos_model_state (Atmos) if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, IPD_Control%nx, IPD_Control%ny, & - IPD_Control%levs, 1, 1, 1.d0, time_int, time_intfull, & + IPD_Control%levs, 1, 1, 1.0_kind_phys, time_int, time_intfull, & IPD_Control%fhswr, IPD_Control%fhlwr) if (nint(IPD_Control%fhzero) > 0) then if (mod(isec,3600*nint(IPD_Control%fhzero)) == 0) diag_time = Atmos%Time @@ -1191,6 +1191,9 @@ subroutine update_atmos_chemistry(state, rc) ntb = size(IPD_Data(1)%IntDiag%duem, dim=2) nte = size(qu, dim=3) do it = 1, min(ntb, nte) +!$OMP parallel do default (none) & +!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qu) & +!$OMP private (j, jb, i, ib, nb, ix) do j = 1, nj jb = j + Atm_block%jsc - 1 do i = 1, ni @@ -1203,17 +1206,22 @@ subroutine update_atmos_chemistry(state, rc) enddo nte = nte - ntb - do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte) - do j = 1, nj - jb = j + Atm_block%jsc - 1 - do i = 1, ni - ib = i + Atm_block%isc - 1 - nb = Atm_block%blkno(ib,jb) - ix = Atm_block%ixp(ib,jb) - IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb) + if (nte > 0) then + do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte) +!$OMP parallel do default (none) & +!$OMP shared (it, nj, ni, ntb, Atm_block, IPD_Data, qu) & +!$OMP private (j, jb, i, ib, nb, ix) + do j = 1, nj + jb = j + Atm_block%jsc - 1 + do i = 1, ni + ib = i + Atm_block%isc - 1 + nb = Atm_block%blkno(ib,jb) + ix = Atm_block%ixp(ib,jb) + IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb) + enddo enddo enddo - enddo + endif !--- (c) sedimentation and dry/wet deposition do it = 1, size(qd, dim=3) @@ -1678,7 +1686,7 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - tem = 100.0 * max(zero, min(0.1, datar8(i,j))) + tem = 100.0_kind_phys * max(zero, min(0.1_kind_phys, datar8(i,j))) IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem IPD_Data(nb)%Sfcprop%zorlo(ix) = tem diff --git a/ccpp/physics b/ccpp/physics index f1c24fbd5..e19953d0d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f1c24fbd54d66fa78bb776d3770cd97b5dd2ba89 +Subproject commit e19953d0da2ccd4b65bc4ac68a2cc09807805474 From dd978481add70c862474c250c4e4740906e3c2f6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 23 Apr 2020 01:50:28 +0000 Subject: [PATCH 039/217] changing _kind_phys to ipd_kind_phys --- atmos_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index b978c2a71..05856e067 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -895,7 +895,7 @@ subroutine update_atmos_model_state (Atmos) if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, IPD_Control%nx, IPD_Control%ny, & - IPD_Control%levs, 1, 1, 1.0_kind_phys, time_int, time_intfull, & + IPD_Control%levs, 1, 1, 1.0_IPD_kind_phys, time_int, time_intfull, & IPD_Control%fhswr, IPD_Control%fhlwr) if (nint(IPD_Control%fhzero) > 0) then if (mod(isec,3600*nint(IPD_Control%fhzero)) == 0) diag_time = Atmos%Time @@ -1686,7 +1686,7 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - tem = 100.0_kind_phys * max(zero, min(0.1_kind_phys, datar8(i,j))) + tem = 100.0_IPD_kind_phys * max(zero, min(0.1_IPD_kind_phys, datar8(i,j))) IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem IPD_Data(nb)%Sfcprop%zorlo(ix) = tem From 6a30d2cb5c5358dcaecf44f63a54c8daa763b208 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 10:54:14 +0000 Subject: [PATCH 040/217] after merging with fv3atm after ccn update and some bug fix --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 15 +++- gfsphysics/GFS_layer/GFS_typedefs.meta | 7 ++ gfsphysics/physics/m_micro_driver.F90 | 3 +- gfsphysics/physics/sfc_cice.f | 27 +++++-- gfsphysics/physics/sfc_sice.f | 80 +++++++++++---------- 5 files changed, 85 insertions(+), 47 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 8fb88d492..7325cfcb2 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1964,9 +1964,10 @@ subroutine GFS_physics_driver & flag_cice, flag_iter, & Coupling%dqsfcin_cpl, Coupling%dtsfcin_cpl, & Coupling%dusfcin_cpl, Coupling%dvsfcin_cpl, & + Coupling%hsnoin_cpl, & ! --- outputs: qss3(:,2), cmm3(:,2), chh3(:,2), evap3(:,2), hflx3(:,2), & - stress3(:,2)) + stress3(:,2), weasd3(:,2), snowd3(:,2), ep1d3(:,2)) endif !*## CCPP ## @@ -2105,11 +2106,15 @@ subroutine GFS_physics_driver & Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land stress(i) = stress3(i,1) ! Sfcprop%tprcp(i) = tprcp3(i,1) + Sfcprop%tsfco(i) = tsfc3(i,1) + Sfcprop%tisfc(i) = tsfc3(i,1) elseif (islmsk(i) == 0) then k = 3 Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled) stress(i) = stress3(i,3) ! Sfcprop%tprcp(i) = tprcp3(i,3) + Sfcprop%tisfc(i) = tsfc3(i,3) + Sfcprop%tsfcl(i) = tsfc3(i,3) else k = 2 stress(i) = stress3(i,2) @@ -2140,7 +2145,7 @@ subroutine GFS_physics_driver & Sfcprop%zorlo(i) = zorl3(i,3) if (flag_cice(i)) then - if (wet(i) .and. fice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice + if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice txi = fice(i) txo = one - txi evap(i) = txi * evap3(i,2) + txo * evap3(i,3) @@ -2158,6 +2163,12 @@ subroutine GFS_physics_driver & Sfcprop%tisfc(i) = Sfcprop%tsfc(i) icy(i) = .false. endif + Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + if (wet(i)) then + Sfcprop%tsfco(i) = tsfc3(i,3) + else + Sfcprop%tsfco(i) =Sfcprop%tsfc(i) + endif enddo endif ! if (Model%frac_grid) !*## CCPP ## diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index f02602277..4a5f0e6aa 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -1771,6 +1771,13 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys +[hsnoin_cpl] + standard_name = surface_snow_thickness_for_coupling + long_name = sfc snow depth in meters over sea ice for coupling + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys [slimskin_cpl] standard_name = sea_land_ice_mask_in long_name = sea/land/ice mask input (=0/1/2) diff --git a/gfsphysics/physics/m_micro_driver.F90 b/gfsphysics/physics/m_micro_driver.F90 index 7d14f5faa..276a2f3bc 100644 --- a/gfsphysics/physics/m_micro_driver.F90 +++ b/gfsphysics/physics/m_micro_driver.F90 @@ -533,7 +533,6 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & NCPL(i,l) = MAX( NCPL(i,l), zero) NCPI(i,l) = MAX( NCPI(i,l), zero) RAD_CF(i,l) = max(zero, min(CLLS(i,l)+CLCN(i,l), one)) - if (.not. iccn) then if (iccn /= 1) then CDNC_NUC(i,l) = zero INC_NUC(i,l) = zero @@ -594,7 +593,7 @@ subroutine m_micro_driver(im, ix, lm, flipv, dt_i & else AERMASSMIX(:,:,1:5) = 1.0d-6 AERMASSMIX(:,:,6:15) = 2.0d-14 - end if + endif call AerConversion1 (AERMASSMIX, AeroProps) deallocate(AERMASSMIX) diff --git a/gfsphysics/physics/sfc_cice.f b/gfsphysics/physics/sfc_cice.f index 2a273688d..8e28b8f5d 100644 --- a/gfsphysics/physics/sfc_cice.f +++ b/gfsphysics/physics/sfc_cice.f @@ -29,9 +29,10 @@ subroutine sfc_cice & ! --- inputs: & ( im, t1, q1, cm, ch, prsl1, & & wind, flag_cice, flag_iter, dqsfc, dtsfc, & - & dusfc, dvsfc, & + & dusfc, dvsfc, snowd, & +! --- input/output: ! --- outputs: - & qsurf, cmm, chh, evap, hflx, stress ) + & qsurf, cmm, chh, evap, hflx, stress, weasd, snwdph, ep) ! ===================================================================== ! ! description: ! @@ -43,6 +44,8 @@ subroutine sfc_cice & ! inputs: ! ! ( im, t1, q1, cm, ch, prsl1, ! ! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! +! --- input/output: ! +! weasd, ep, trpcp, ! ! outputs: ! ! qsurf, cmm, chh, evap, hflx) ! ! ! @@ -64,6 +67,8 @@ subroutine sfc_cice & ! dusfc - real, zonal momentum stress ! dvsfc - real, meridional momentum stress ! dvsfc - real, sensible heat flux +! showd - real, snow depth from cice +! input/outputs: ! outputs: ! qsurf - real, specific humidity at sfc ! cmm - real, ? @@ -71,26 +76,33 @@ subroutine sfc_cice & ! evap - real, evaperation from latent heat ! hflx - real, sensible heat ! stress - real, surface stress +! weasd - real, water equivalent accumulated snow depth (mm) +! snwdph - real, water equivalent snow depth (mm) +! ep - real, potential evaporation + ! ==================== end of description ===================== ! ! ! ! --- constant parameters: - real(kind=kind_phys), parameter :: one = 1.0d0 + real(kind=kind_phys), parameter :: one = 1.0_kind_phys real(kind=kind_phys), parameter :: cpinv = one/cp real(kind=kind_phys), parameter :: hvapi = one/hvap + real(kind=kind_phys), parameter :: dsi = one/0.33_kind_phys ! --- inputs: integer, intent(in) :: im ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(im), intent(in) :: & - & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc + & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc, & + & snowd logical, intent(in) :: flag_cice(im), flag_iter(im) ! --- outputs: - real (kind=kind_phys), dimension(im), intent(out) :: qsurf, & - & cmm, chh, evap, hflx, stress + real (kind=kind_phys), dimension(im), intent(inout) :: qsurf, & + & cmm, chh, evap, hflx, stress, & + & weasd, snwdph, ep ! --- locals: @@ -111,6 +123,9 @@ subroutine sfc_cice & hflx(i) = dtsfc(i) * tem * cpinv evap(i) = dqsfc(i) * tem * hvapi stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem + weasd(i) = snowd(i) * 1000.0_kind_phys + snwdph(i) = weasd(i) * dsi ! snow depth in mm + ep(i) = evap(i) endif enddo diff --git a/gfsphysics/physics/sfc_sice.f b/gfsphysics/physics/sfc_sice.f index edb8034fe..c3680aa93 100644 --- a/gfsphysics/physics/sfc_sice.f +++ b/gfsphysics/physics/sfc_sice.f @@ -124,18 +124,19 @@ subroutine sfc_sice & ! ! ! --- constant parameters: - integer, parameter :: kmi = 2 ! 2-layer of ice - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + integer, parameter :: kmi = 2 ! 2-layer of ice + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys real(kind=kind_phys), parameter :: cpinv = one/cp real(kind=kind_phys), parameter :: hvapi = one/hvap real(kind=kind_phys), parameter :: elocp = hvap/cp - real(kind=kind_phys), parameter :: himax = 8.0d0 ! maximum ice thickness allowed - real(kind=kind_phys), parameter :: himin = 0.1d0 ! minimum ice thickness required - real(kind=kind_phys), parameter :: hsmax = 2.0d0 ! maximum snow depth allowed - real(kind=kind_phys), parameter :: timin = 173.0d0 ! minimum temperature allowed for snow/ice - real(kind=kind_phys), parameter :: albfw = 0.06d0 ! albedo for lead - real(kind=kind_phys), parameter :: dsi = one/0.33d0 - real(kind=kind_phys), parameter :: qmin = 1.0d-8 + real(kind=kind_phys), parameter :: himax = 8.0_kind_phys ! maximum ice thickness allowed + real(kind=kind_phys), parameter :: himin = 0.1_kind_phys ! minimum ice thickness required + real(kind=kind_phys), parameter :: hsmax = 2.0_kind_phys ! maximum snow depth allowed + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice + real(kind=kind_phys), parameter :: albfw = 0.06_kind_phys ! albedo for lead + real(kind=kind_phys), parameter :: dsi = one/0.33_kind_phys + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys ! --- inputs: integer, intent(in) :: im, km, ipr @@ -157,7 +158,7 @@ subroutine sfc_sice & real (kind=kind_phys), dimension(im,km), intent(inout) :: stc ! --- outputs: - real (kind=kind_phys), dimension(im), intent(out) :: snwdph, & + real (kind=kind_phys), dimension(im), intent(inout) :: snwdph, & & qsurf, snowmt, gflux, cmm, chh, evap, hflx ! --- locals: @@ -244,7 +245,7 @@ subroutine sfc_sice & ! --- ... snow depth in water equivalent is converted from mm to m unit - snowd(i) = weasd(i) * 0.001d0 + snowd(i) = weasd(i) * 0.001_kind_phys ! flagsnw(i) = .false. ! --- ... when snow depth is less than 1 mm, a patchy snow is assumed and @@ -265,7 +266,8 @@ subroutine sfc_sice & ! evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) snetw(i) = sfcdsw(i) * (one - albfw) - snetw(i) = min(3.0d0*sfcnsw(i)/(one+2.0d0*ffw(i)), snetw(i)) + snetw(i) = min(3.0_kind_phys*sfcnsw(i) & + & / (one+2.0_kind_phys*ffw(i)), snetw(i)) sneti(i) = (sfcnsw(i) - ffw(i)*snetw(i)) / fice(i) t12 = tice(i) * tice(i) @@ -275,7 +277,7 @@ subroutine sfc_sice & hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & & + rch(i)*(tice(i) - theta1(i)) - hfd(i) = 4.0d0*sfcemis(i)*sbc*tice(i)*t12 & + hfd(i) = 4.0_kind_phys*sfcemis(i)*sbc*tice(i)*t12 & & + (one + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) @@ -287,13 +289,13 @@ subroutine sfc_sice & ! hfw(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapw(i) & ! & + rch(i)*(tgice - theta1(i)) - snetw(i) - focn(i) = 2.0d0 ! heat flux from ocean - should be from ocn model + focn(i) = 2.0_kind_phys ! heat flux from ocean - should be from ocn model snof(i) = zero ! snowfall rate - snow accumulates in gbphys hice(i) = max( min( hice(i), himax ), himin ) snowd(i) = min( snowd(i), hsmax ) - if (snowd(i) > (2.0d0*hice(i))) then + if (snowd(i) > (2.0_kind_phys*hice(i))) then print *, 'warning: too much snow :',snowd(i) snowd(i) = hice(i) + hice(i) print *,'fix: decrease snow depth to:',snowd(i) @@ -357,7 +359,7 @@ subroutine sfc_sice & ! --- ... convert snow depth back to mm of water equivalent - weasd(i) = snowd(i) * 1000.0d0 + weasd(i) = snowd(i) * 1000.0_kind_phys snwdph(i) = weasd(i) * dsi ! snow depth in mm tem = one / rho(i) @@ -438,28 +440,32 @@ subroutine ice3lay ! ! --- constant parameters: (properties of ice, snow, and seawater) - real (kind=kind_phys), parameter :: ds = 330.0d0 ! snow (ov sea ice) density (kg/m^3) - real (kind=kind_phys), parameter :: dw =1000.0d0 ! fresh water density (kg/m^3) + real (kind=kind_phys), parameter :: ds = 330.0_kind_phys ! snow (ov sea ice) density (kg/m^3) + real (kind=kind_phys), parameter :: dw =1000.0_kind_phys ! fresh water density (kg/m^3) real (kind=kind_phys), parameter :: dsdw = ds/dw real (kind=kind_phys), parameter :: dwds = dw/ds - real (kind=kind_phys), parameter :: ks = 0.31d0 ! conductivity of snow (w/mk) - real (kind=kind_phys), parameter :: i0 = 0.3d0 ! ice surface penetrating solar fraction - real (kind=kind_phys), parameter :: ki = 2.03d0 ! conductivity of ice (w/mk) - real (kind=kind_phys), parameter :: di = 917.0d0 ! density of ice (kg/m^3) + real (kind=kind_phys), parameter :: ks = 0.31_kind_phys ! conductivity of snow (w/mk) + real (kind=kind_phys), parameter :: i0 = 0.3_kind_phys ! ice surface penetrating solar fraction + real (kind=kind_phys), parameter :: ki = 2.03_kind_phys ! conductivity of ice (w/mk) + real (kind=kind_phys), parameter :: di = 917.0_kind_phys ! density of ice (kg/m^3) real (kind=kind_phys), parameter :: didw = di/dw real (kind=kind_phys), parameter :: dsdi = ds/di - real (kind=kind_phys), parameter :: ci = 2054.0d0 ! heat capacity of fresh ice (j/kg/k) - real (kind=kind_phys), parameter :: li = 3.34d5 ! latent heat of fusion (j/kg-ice) - real (kind=kind_phys), parameter :: si = 1.0d0 ! salinity of sea ice - real (kind=kind_phys), parameter :: mu = 0.054d0 ! relates freezing temp to salinity - real (kind=kind_phys), parameter :: tfi = -mu*si ! sea ice freezing temp = -mu*salinity - real (kind=kind_phys), parameter :: tfw = -1.8d0 ! tfw - seawater freezing temp (c) - real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001d0 + real (kind=kind_phys), parameter :: ci = 2054.0_kind_phys ! heat capacity of fresh ice (j/kg/k) + real (kind=kind_phys), parameter :: li = 3.34e5_kind_phys ! latent heat of fusion (j/kg-ice) + real (kind=kind_phys), parameter :: si = 1.0_kind_phys ! salinity of sea ice + real (kind=kind_phys), parameter :: mu = 0.054_kind_phys ! relates freezing temp to salinity + real (kind=kind_phys), parameter :: tfi = -mu*si ! sea ice freezing temp = -mu*salinity + real (kind=kind_phys), parameter :: tfw = -1.8_kind_phys ! tfw - seawater freezing temp (c) + real (kind=kind_phys), parameter :: tfi0 = tfi-0.0001_kind_phys real (kind=kind_phys), parameter :: dici = di*ci real (kind=kind_phys), parameter :: dili = di*li real (kind=kind_phys), parameter :: dsli = ds*li - real (kind=kind_phys), parameter :: ki4 = ki*4.0d0 - real (kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 + real (kind=kind_phys), parameter :: ki4 = ki*4.0_kind_phys + + real (kind=kind_phys), parameter :: zero = 0.0_kind_phys + real (kind=kind_phys), parameter :: half = 0.5_kind_phys + real (kind=kind_phys), parameter :: one = 1.0_kind_phys + real (kind=kind_phys), parameter :: four = 4.0_kind_phys ! --- inputs: integer, intent(in) :: im, kmi, ipr @@ -541,13 +547,13 @@ subroutine ice3lay b1 = b10 + ai * wrk1 c1 = dili * tfi * dt2i * hice(i) - stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1 - four*a1*c1) + b1)/(a1+a1) tice(i) = (k12*stsice(i,1) - ai) / (k12 + bi) if (tice(i) > tsf) then a1 = a10 + k12 b1 = b10 - k12*tsf - stsice(i,1) = -(sqrt(b1*b1 - 4.0d0*a1*c1) + b1)/(a1+a1) + stsice(i,1) = -(sqrt(b1*b1 - four*a1*c1) + b1)/(a1+a1) tice(i) = tsf tmelt = (k12*(stsice(i,1)-tsf) - (ai+bi*tsf)) * delt else @@ -562,8 +568,8 @@ subroutine ice3lay ! --- ... resize the ice ... - h1 = 0.5d0 * hice(i) - h2 = 0.5d0 * hice(i) + h1 = half * hice(i) + h2 = half * hice(i) ! --- ... top ... @@ -592,7 +598,7 @@ subroutine ice3lay hice(i) = h1 + h2 if (hice(i) > zero) then - if (h1 > 0.5d0*hice(i)) then + if (h1 > half*hice(i)) then f1 = one - (h2+h2) / hice(i) stsice(i,2) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& & + (one - f1)*stsice(i,2) @@ -606,7 +612,7 @@ subroutine ice3lay stsice(i,1) = f1 * (stsice(i,1) + li*tfi/(ci*stsice(i,1)))& & + (one - f1)*stsice(i,2) stsice(i,1) = (stsice(i,1) - sqrt(stsice(i,1)*stsice(i,1) & - & - 4.0d0*tfi*li/ci)) * 0.5d0 + & - four*tfi*li/ci)) * half endif k12 = ki4*ks / (ks*hice(i) + ki4*snowd(i)) From 9c9cc04081c4108eff8c21ef2dfc489ea8773982 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 11:09:19 +0000 Subject: [PATCH 041/217] fixing some comment lines --- ccpp/physics | 2 +- gfsphysics/physics/sfc_cice.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index e19953d0d..f85730de9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e19953d0da2ccd4b65bc4ac68a2cc09807805474 +Subproject commit f85730de98a126e7552b4bdc9d31ceb9c3ae067d diff --git a/gfsphysics/physics/sfc_cice.f b/gfsphysics/physics/sfc_cice.f index 8e28b8f5d..6e4f7ddb5 100644 --- a/gfsphysics/physics/sfc_cice.f +++ b/gfsphysics/physics/sfc_cice.f @@ -67,7 +67,7 @@ subroutine sfc_cice & ! dusfc - real, zonal momentum stress ! dvsfc - real, meridional momentum stress ! dvsfc - real, sensible heat flux -! showd - real, snow depth from cice +! snowd - real, snow depth from cice ! input/outputs: ! outputs: ! qsurf - real, specific humidity at sfc From 2892c929792188152d19546ddf2c99a97a1c8a66 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 11:12:24 +0000 Subject: [PATCH 042/217] fixing some comment lines --- ccpp/physics | 2 +- gfsphysics/physics/sfc_cice.f | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index f85730de9..024144911 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f85730de98a126e7552b4bdc9d31ceb9c3ae067d +Subproject commit 02414491112c736f75081f26ad508c70925d265a diff --git a/gfsphysics/physics/sfc_cice.f b/gfsphysics/physics/sfc_cice.f index 6e4f7ddb5..970d4d80b 100644 --- a/gfsphysics/physics/sfc_cice.f +++ b/gfsphysics/physics/sfc_cice.f @@ -44,10 +44,9 @@ subroutine sfc_cice & ! inputs: ! ! ( im, t1, q1, cm, ch, prsl1, ! ! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! -! --- input/output: ! -! weasd, ep, trpcp, ! +! dusfc, dvsfc, snowd, ! ! outputs: ! -! qsurf, cmm, chh, evap, hflx) ! +! qsurf, cmm, chh, evap, hflx, stress, weasd, snwdph, ep) ! ! ! ! ==================== defination of variables ==================== ! ! ! @@ -68,7 +67,6 @@ subroutine sfc_cice & ! dvsfc - real, meridional momentum stress ! dvsfc - real, sensible heat flux ! snowd - real, snow depth from cice -! input/outputs: ! outputs: ! qsurf - real, specific humidity at sfc ! cmm - real, ? From 0c2bf169e44e3eb196ef0fc4fa687b7dc66ce872 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Apr 2020 14:21:30 +0000 Subject: [PATCH 043/217] minor update to ipd phys driver --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 024144911..4694c0088 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 02414491112c736f75081f26ad508c70925d265a +Subproject commit 4694c008851cceb7ef1977b48d00067f49fca69d diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 7325cfcb2..2967d1d87 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2152,6 +2152,8 @@ subroutine GFS_physics_driver & hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) stress(i) = txi *stress3(i,2) + txo * stress3(i,3) + qss(i) = txi * qss3(i,2) + txo * qss3(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d(i,3) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) From 71f31436f84f24d243f8d038372080b49fa795c4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Apr 2020 13:25:57 +0000 Subject: [PATCH 044/217] some additional updates - not necessarily completely correct --- atmos_model.F90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 05856e067..dfc22ad2c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1936,15 +1936,18 @@ subroutine assign_importdata(rc) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then !if it is ocean or ice get surface temperature from mediator if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then - IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) - IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) - 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) + IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) + IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) + 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) + IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & + / max(0.01, IPD_Data(nb)%Coupling%ficein_cpl(ix)) else - IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) - IPD_Data(nb)%Sfcprop%fice(ix) = zero - IPD_Data(nb)%Sfcprop%hice(ix) = zero - IPD_Data(nb)%Sfcprop%snowd(ix) = zero + 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 + IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = zero ! IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! over open water - should not be used in ATM IPD_Data(nb)%Coupling%dqsfcin_cpl(ix) = -99999.0 ! ,, From 3e8150a64b49e4eb409f54fa19412f5353751b09 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 29 Apr 2020 13:08:39 +0000 Subject: [PATCH 045/217] testing an alternate option --- ccpp/physics | 2 +- gfsphysics/physics/sfc_cice.f | 9 +++++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 4694c0088..e216116db 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4694c008851cceb7ef1977b48d00067f49fca69d +Subproject commit e216116dbccb9b456a3c3eaf33d7bc5cca890725 diff --git a/gfsphysics/physics/sfc_cice.f b/gfsphysics/physics/sfc_cice.f index 970d4d80b..64a2565cb 100644 --- a/gfsphysics/physics/sfc_cice.f +++ b/gfsphysics/physics/sfc_cice.f @@ -121,8 +121,13 @@ subroutine sfc_cice & hflx(i) = dtsfc(i) * tem * cpinv evap(i) = dqsfc(i) * tem * hvapi stress(i) = sqrt(dusfc(i)*dusfc(i) + dvsfc(i)*dvsfc(i)) * tem - weasd(i) = snowd(i) * 1000.0_kind_phys - snwdph(i) = weasd(i) * dsi ! snow depth in mm + + snwdph(i) = snowd(i) * 1000.0_kind_phys + weasd(i) = snwdph(i) * 0.33_kind_phys + +! weasd(i) = snowd(i) * 1000.0_kind_phys +! snwdph(i) = weasd(i) * dsi ! snow depth in mm + ep(i) = evap(i) endif enddo From a4fd1add4ffaf29777ce830a81a623e1fe8f5591 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 30 Apr 2020 02:01:21 +0000 Subject: [PATCH 046/217] some additional update to ipd driver --- atmos_model.F90 | 2 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 184 ++++++++++---------- 3 files changed, 94 insertions(+), 94 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index dfc22ad2c..d2f65520c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1941,7 +1941,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) IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & - / max(0.01, IPD_Data(nb)%Coupling%ficein_cpl(ix)) + / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) else IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) IPD_Data(nb)%Sfcprop%fice(ix) = zero diff --git a/ccpp/physics b/ccpp/physics index e216116db..d61ecbe02 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e216116dbccb9b456a3c3eaf33d7bc5cca890725 +Subproject commit d61ecbe02a64c872212644cd472de77ee73605e2 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 2967d1d87..bfdf8f4b6 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -44,22 +44,22 @@ 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-8 - real(kind=kind_phys), parameter :: qsmall = 1.0d-20 - real(kind=kind_phys), parameter :: rainmin = 1.0d-13 - real(kind=kind_phys), parameter :: p850 = 85000.0d0 - real(kind=kind_phys), parameter :: epsq = 1.0d-20 + real(kind=kind_phys), parameter :: epsln = 1.0e-10_kind_phys + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys + real(kind=kind_phys), parameter :: qsmall = 1.0e-20_kind_phys + real(kind=kind_phys), parameter :: rainmin = 1.0e-13_kind_phys + real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys + real(kind=kind_phys), parameter :: epsq = 1.0e-20_kind_phys real(kind=kind_phys), parameter :: hsub = con_hvap+con_hfus - real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, & - half = 0.5d0, onebg = one/con_g - real(kind=kind_phys), parameter :: albdf = 0.06d0 - real(kind=kind_phys), parameter :: tf=258.16d0, tcr=273.16d0, tcrf=one/(tcr-tf) - real(kind=kind_phys), parameter :: con_p001= 0.001d0 - real(kind=kind_phys), parameter :: con_day = 86400.0d0 - real(kind=kind_phys), parameter :: rad2dg = 180.0d0/con_pi - real(kind=kind_phys), parameter :: omz1 = 10.0d0 + real(kind=kind_phys), parameter :: czmin = 0.0001_kind_phys ! cos(89.994) + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, & + half = 0.5_kind_phys, onebg = one/con_g + real(kind=kind_phys), parameter :: albdf = 0.06_kind_phys + real(kind=kind_phys), parameter :: tf=258.16_kind_phys, tcr=273.16_kind_phys, tcrf=one/(tcr-tf) + real(kind=kind_phys), parameter :: con_p001= 0.001_kind_phys + real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys + real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi + real(kind=kind_phys), parameter :: omz1 = 10.0_kind_phys real(kind=kind_phys), parameter :: huge = zero !> GFS Physics Implementation Layer @@ -1042,7 +1042,7 @@ subroutine GFS_physics_driver & !## CCPP ##* GFS_surface_generic.F90/GFS_surface_generic_pre_run do i = 1, IM - sigmaf(i) = max( Sfcprop%vfrac(i),0.01d0 ) + sigmaf(i) = max( Sfcprop%vfrac(i),0.01_kind_phys ) islmsk(i) = nint(Sfcprop%slmsk(i)) if (islmsk(i) == 2) then @@ -1058,9 +1058,9 @@ subroutine GFS_physics_driver & endif slopetyp(i) = 9 else - soiltyp(i) = int( Sfcprop%stype(i)+0.5 ) - vegtype(i) = int( Sfcprop%vtype(i)+0.5 ) - slopetyp(i) = int( Sfcprop%slope(i)+0.5 ) !! clu: slope -> slopetyp + soiltyp(i) = int( Sfcprop%stype(i)+half ) + vegtype(i) = int( Sfcprop%vtype(i)+half ) + slopetyp(i) = int( Sfcprop%slope(i)+half ) !! clu: slope -> slopetyp if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 if (slopetyp(i) < 1) slopetyp(i) = 1 @@ -1237,7 +1237,7 @@ subroutine GFS_physics_driver & ! snowd3(i,3) = Sfcprop%snowd(i) snowd3(i,3) = zero weasd3(i,3) = zero - semis3(i,3) = 0.984d0 + semis3(i,3) = 0.984_kind_phys endif ! if (dry(i)) then ! Land @@ -1259,7 +1259,7 @@ subroutine GFS_physics_driver & snowd3(i,2) = Sfcprop%snowd(i) ep1d3(i,2) = zero gflx3(i,2) = zero - semis3(i,2) = 0.95d0 + semis3(i,2) = 0.95_kind_phys endif enddo !*## CCPP ## @@ -1515,7 +1515,7 @@ subroutine GFS_physics_driver & do i=1,im if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg tem1 = adjsfcdsw(i) / xcosz(i) - if ( tem1 >= 120.0d0 ) then + if ( tem1 >= 120.0_kind_phys) then Diag%suntim(i) = Diag%suntim(i) + dtf endif endif @@ -1597,8 +1597,8 @@ subroutine GFS_physics_driver & kinver(i) = levs !## CCPP ## GFS_typedefs.F90/interstitial_phys_reset invrsn(i) = .false. tx1(i) = zero - tx2(i) = 10.0d0 - ctei_r(i) = 10.0d0 + tx2(i) = 10.0_kind_phys + ctei_r(i) = 10.0_kind_phys enddo ! Only used for old shallow convection with mstrat=.true. @@ -1608,12 +1608,12 @@ subroutine GFS_physics_driver & ctei_rml(:) = Model%ctei_rm(1)*work1(:) + Model%ctei_rm(2)*work2(:) do k=1,levs/2 do i=1,im - if (Statein%prsi(i,1)-Statein%prsi(i,k+1) < 0.35d0*Statein%prsi(i,1) & + if (Statein%prsi(i,1)-Statein%prsi(i,k+1) < 0.35_kind_phys*Statein%prsi(i,1) & .and. (.not. invrsn(i))) then tem = (Statein%tgrs(i,k+1) - Statein%tgrs(i,k)) & / (Statein%prsl(i,k) - Statein%prsl(i,k+1)) - if (((tem > 0.00010d0) .and. (tx1(i) < zero)) .or. & + if (((tem > 0.00010_kind_phys) .and. (tx1(i) < zero)) .or. & ((tem-abs(tx1(i)) > zero) .and. (tx2(i) < zero))) then invrsn(i) = .true. @@ -1627,7 +1627,7 @@ subroutine GFS_physics_driver & ctei_r(i) = (one/hocp)*tem1/(Statein%qgrs(i,k+1,1)-Statein%qgrs(i,k,1) & + Statein%qgrs(i,k+1,ntcw)-Statein%qgrs(i,k,ntcw)) else - ctei_r(i) = 10.0d0 + ctei_r(i) = 10.0_kind_phys endif if ( ctei_rml(i) > ctei_r(i) ) then @@ -1670,7 +1670,7 @@ subroutine GFS_physics_driver & Diag%smcref2(i) = zero wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & Statein%vgrs(i,1)*Statein%vgrs(i,1)) & - + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0d0)), one) + + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0_kind_phys)), one) !*## CCPP ## enddo !*## CCPP ## @@ -1706,7 +1706,7 @@ subroutine GFS_physics_driver & !*## CCPP ## !## CCPP ##* GFS_surface_loop_control/GFS_surface_loop_control_part1_run do i=1,im - if (iter == 1 .and. wind(i) < 2.0d0) then + if (iter == 1 .and. wind(i) < 2.0_kind_phys) then flag_guess(i) = .true. endif enddo @@ -1780,8 +1780,8 @@ subroutine GFS_physics_driver & ! --- ... run nsst model ... --- if (Model%nstf_name(1) > 1) then - zsea1 = 0.001d0*real(Model%nstf_name(4)) - zsea2 = 0.001d0*real(Model%nstf_name(5)) + zsea1 = 0.001_kind_phys*real(Model%nstf_name(4)) + zsea2 = 0.001_kind_phys*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) do i=1,im @@ -2010,7 +2010,7 @@ subroutine GFS_physics_driver & flag_iter(i) = .false. flag_guess(i) = .false. - if (iter == 1 .and. wind(i) < 2.0d0) then + if (iter == 1 .and. wind(i) < 2.0_kind_phys) then ! if (dry(i) .or. (wet(i) .and. .not.icy(i) & if (dry(i) .or. (wet(i) .and. Model%nstf_name(1) > 0)) then flag_iter(i) = .true. @@ -2088,11 +2088,11 @@ subroutine GFS_physics_driver & ! endif if (.not. flag_cice(i)) then - if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%hice(i) = zice(i) Sfcprop%fice(i) = fice(i) Sfcprop%tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) + else ! this would be over open ocean or land (no ice fraction) Sfcprop%hice(i) = zero Sfcprop%fice(i) = zero Sfcprop%tisfc(i) = Sfcprop%tsfc(i) @@ -2156,7 +2156,7 @@ subroutine GFS_physics_driver & ep1d(i) = txi * ep1d3(i,2) + txo * ep1d(i,3) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array - Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) Sfcprop%hice(i) = zice(i) Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen else ! this would be over open ocean or land (no ice fraction) @@ -2262,11 +2262,11 @@ subroutine GFS_physics_driver & if (wet(i)) then ! some open water ! --- compute open water albedo xcosz_loc = max( zero, min( one, xcosz(i) )) - ocalnirdf_cpl(i) = 0.06d0 - ocalnirbm_cpl(i) = max(albdf, 0.026d0/(xcosz_loc**1.7d0+0.065d0) & - & + 0.15d0 * (xcosz_loc-0.1d0) * (xcosz_loc-0.5d0) & + ocalnirdf_cpl(i) = 0.06_kind_phys + ocalnirbm_cpl(i) = max(albdf, 0.026_kind_phys/(xcosz_loc**1.7_kind_phys+0.065_kind_phys) & + & + 0.15_kind_phys * (xcosz_loc-0.1_kind_phys) * (xcosz_loc-0.5_kind_phys) & & * (xcosz_loc-one)) - ocalvisdf_cpl(i) = 0.06d0 + ocalvisdf_cpl(i) = 0.06 ocalvisbm_cpl(i) = ocalnirbm_cpl(i) Coupling%nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl(i)) @@ -3102,7 +3102,7 @@ subroutine GFS_physics_driver & if (ntke > 0) then tke(1:im,:) = Statein%qgrs(1:im,:,ntke) + dqdt(1:im,:,ntke) * dtp else - tke(:,:) = -9999.0d0 + tke(:,:) = -9999.0_kind_phys endif ! ! tendency without PBL-accumulations @@ -3379,7 +3379,7 @@ subroutine GFS_physics_driver & do k=1,levs do i=1,im clw(i,k,1) = zero - clw(i,k,2) = -999.9d0 + clw(i,k,2) = -999.9_kind_phys enddo enddo @@ -3448,7 +3448,7 @@ subroutine GFS_physics_driver & !## CCPP ## GFS_suite_interstitial.F90/GFS_suite_interstitial_3_run if (ntcw > 0) then ! if (imp_physics == Model%imp_physics_mg .and. .not. Model%do_shoc) then ! compute rhc for GMAO macro physics cloud pdf - if (imp_physics == Model%imp_physics_mg .and. Model%crtrh(2) < 0.5d0) then ! compute rhc for GMAO macro physics cloud pdf + if (imp_physics == Model%imp_physics_mg .and. Model%crtrh(2) < half) then ! compute rhc for GMAO macro physics cloud pdf do i=1,im tx1(i) = one / Statein%prsi(i,1) tx2(i) = one - rhc_max*work1(i) - Model%crtrh(1)*work2(i) @@ -3459,20 +3459,20 @@ subroutine GFS_physics_driver & do k = 1, levs do i = 1, im tem = Statein%prsl(i,k) * tx1(i) - tem1 = min(max((tem-tx3(i))*slope_mg, -20.0d0), 20.0d0) + tem1 = min(max((tem-tx3(i))*slope_mg, -20.0_kind_phys), 20.0_kind_phys) ! ! Using crtrh(2) and crtrh(3) from the namelist instead of 0.3 and 0.2 ! and crtrh(1) represents pbl top critical relative humidity - tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0d0), 20.0d0) + tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0_kind_phys), 20.0_kind_phys) if (islmsk(i) > 0) then tem1 = one / (one+exp(tem1+tem1)) else - tem1 = 2.0d0 / (one+exp(tem1+tem1)) + tem1 = 2.0_kind_phys / (one+exp(tem1+tem1)) endif tem2 = one / (one+exp(tem2)) - rhc(i,k) = min(rhc_max, max(0.7d0, one-tx2(i)*tem1*tem2)) + rhc(i,k) = min(rhc_max, max(0.7_kind_phys, one-tx2(i)*tem1*tem2)) enddo enddo else @@ -3907,7 +3907,7 @@ subroutine GFS_physics_driver & do k=1,levs kk = min(k+1,levs) ! assuming no cloud top reaches the model top do i=1,im !DD - sigmafrac(i,k) = 0.5d0 * (sigmatot(i,k)+sigmatot(i,kk)) + sigmafrac(i,k) = half * (sigmatot(i,k)+sigmatot(i,kk)) enddo enddo endif @@ -3933,7 +3933,7 @@ subroutine GFS_physics_driver & enddo else do i=1,im - ccwfac(i) = -999.0d0 + ccwfac(i) = -999.0_kind_phys dlqfac(i) = zero psaur_l(i) = Model%psauras(1)*work1(i) + Model%psauras(2)*work2(i) praur_l(i) = Model%prauras(1)*work1(i) + Model%prauras(2)*work2(i) @@ -3953,8 +3953,8 @@ subroutine GFS_physics_driver & revap = .true. ! if (ncld ==2) revap = .false. - trcmin(:) = -999999.0d0 - if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 + trcmin(:) = -999999.0_kind_phys + if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_kind_phys !*## CCPP ## ! if (lprnt) write(0,*)' gt04bras=',Stateout%gt0(ipr,:) ! if (lprnt) write(0,*)' gq04bras=',Stateout%gq0(ipr,:,1) @@ -4265,10 +4265,10 @@ subroutine GFS_physics_driver & do k=1,levs do i=1,im - eng0 = 0.5d0*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + eng0 = half*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) Stateout%gu0(i,k) = Stateout%gu0(i,k) + gwdcu(i,k) * dtp Stateout%gv0(i,k) = Stateout%gv0(i,k) + gwdcv(i,k) * dtp - eng1 = 0.5d0*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + eng1 = half*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) Stateout%gt0(i,k) = Stateout%gt0(i,k) + (eng0-eng1)/(dtp*con_cp) enddo ! if (lprnt) write(7000,*)' gu0=',gu0(ipr,k),' gwdcu=', @@ -4413,7 +4413,7 @@ subroutine GFS_physics_driver & levshc(:) = 0 do k=2,levs do i=1,im - dpshc = 0.3d0 * Statein%prsi(i,1) + dpshc = 0.3_kind_phys * Statein%prsi(i,1) if (Statein%prsi(i,1)-Statein%prsi(i,k) <= dpshc) levshc(i) = k enddo enddo @@ -4464,7 +4464,7 @@ subroutine GFS_physics_driver & ! do k=1,levs do i=1,im - if (clw(i,k,2) <= -999.0d0) clw(i,k,2) = zero + if (clw(i,k,2) <= -999.0_kind_phys) clw(i,k,2) = zero enddo enddo !*## CCPP ## @@ -5200,8 +5200,8 @@ subroutine GFS_physics_driver & if (Model%effr_in) then do i =1, im - den(i,k) = 0.622d0*Statein%prsl(i,k) / & - (con_rd*Stateout%gt0(i,k)*(Stateout%gq0(i,k,1)+0.622d0)) + den(i,k) = 0.622_kind_phys*Statein%prsl(i,k) / & + (con_rd*Stateout%gt0(i,k)*(Stateout%gq0(i,k,1)+0.622_kind_phys)) enddo endif enddo @@ -5216,8 +5216,8 @@ subroutine GFS_physics_driver & 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.0d0 - Diag%refdmax263k(I) = -35.0d0 + Diag%refdmax(I) = -35.0_kind_phys + Diag%refdmax263k(I) = -35.0_kind_phys enddo endif do i=1,im @@ -5411,14 +5411,15 @@ subroutine GFS_physics_driver & enddo enddo - if (Model%imp_physics == Model%imp_physics_gfdl) then + if (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL microphysics + ! ----------------- ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP tem = dtp * con_p001 / con_day do i = 1, im Sfcprop%tprcp(i) = max(zero, Diag%rain(i) )! clu: rain -> tprcp Sfcprop%srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) - if (Sfcprop%tsfc(i) >= 273.15d0) then + if (Sfcprop%tsfc(i) >= 273.15_kind_phys) then crain = Diag%rainc(i) csnow = zero else @@ -5446,12 +5447,13 @@ subroutine GFS_physics_driver & #endif enddo elseif( .not. Model%cal_pre) then - if (Model%imp_physics == Model%imp_physics_mg) then ! MG microphysics + if (Model%imp_physics == Model%imp_physics_mg) then ! MG microphysics + ! --------------- do i=1,im if (Diag%rain(i) > rainmin) then tem1 = max(zero, (Diag%rain(i)-Diag%rainc(i))) * Diag%sr(i) tem2 = one / Diag%rain(i) - if (t850(i) > 273.16d0) then + if (t850(i) > 273.16_kind_phys) then Sfcprop%srflag(i) = max(zero, min(one, tem1*tem2)) else Sfcprop%srflag(i) = max(zero, min(one, (tem1+Diag%rainc(i))*tem2)) @@ -5461,15 +5463,13 @@ subroutine GFS_physics_driver & Diag%rain(i) = zero Diag%rainc(i) = zero endif - Sfcprop%tprcp(i) = max(zero, Diag%rain(i) ) ! clu: rain -> tprcp + Sfcprop%tprcp(i) = max(zero, Diag%rain(i)) enddo - else + else ! not GFDL or MG microphysics + ! --------------------------- do i = 1, im - Sfcprop%tprcp(i) = max(zero, Diag%rain(i) ) ! clu: rain -> tprcp - Sfcprop%srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) - if (t850(i) <= 273.16d0) then - Sfcprop%srflag(i) = one ! clu: set srflag to 'snow' (i.e. 1) - endif + Sfcprop%tprcp(i) = max(zero, Diag%rain(i)) + Sfcprop%srflag(i) = Diag%sr(i) enddo endif endif @@ -5662,13 +5662,13 @@ subroutine GFS_physics_driver & if (reset) then do i=1, im ! find max hourly wind speed then decompose - Diag%spd10max(i) = -999. - Diag%u10max(i) = -999. - Diag%v10max(i) = -999. - Diag%t02max(i) = -999. - Diag%t02min(i) = 999. - Diag%rh02max(i) = -999. - Diag%rh02min(i) = 999. + Diag%spd10max(i) = -999.0_kind_phys + Diag%u10max(i) = -999.0_kind_phys + Diag%v10max(i) = -999.0_kind_phys + Diag%t02max(i) = -999.0_kind_phys + Diag%t02min(i) = 999.0_kind_phys + Diag%rh02max(i) = -999.0_kind_phys + Diag%rh02min(i) = 999.0_kind_phys enddo endif do i=1, im @@ -5679,7 +5679,7 @@ subroutine GFS_physics_driver & Diag%u10max(i) = Diag%u10m(i) Diag%v10max(i) = Diag%v10m(i) endif - pshltr = Statein%pgr(i)*exp(-0.068283d0/Stateout%gt0(i,1)) + pshltr = Statein%pgr(i)*exp(-0.068283_kind_phys/Stateout%gt0(i,1)) QCQ = PQ0/pshltr*EXP(A2A*(Sfcprop%t2m(i)-A3)/(Sfcprop%t2m(i)-A4)) rh02 = Sfcprop%q2m(i) / QCQ IF (rh02 > one) THEN @@ -5799,10 +5799,10 @@ subroutine moist_bud(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & integer :: i, k ! do i=1,im - sumqv(i) = 0.0 - sumql(i) = 0.0 - sumqi(i) = 0.0 - sumq (i) = 0.0 + sumqv(i) = 0.0_kind_phys + sumql(i) = 0.0_kind_phys + sumqi(i) = 0.0_kind_phys + sumq (i) = 0.0_kind_phys enddo do k=1,levs do i=1,im @@ -5812,9 +5812,9 @@ subroutine moist_bud(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & enddo enddo do i=1,im - sumqv(i) = - sumqv(i) * (1.0/grav) - sumql(i) = - sumql(i) * (1.0/grav) - sumqi(i) = - sumqi(i) * (1.0/grav) + sumqv(i) = - sumqv(i) * (1.0_kind_phys/grav) + sumql(i) = - sumql(i) * (1.0_kind_phys/grav) + sumqi(i) = - sumqi(i) * (1.0_kind_phys/grav) sumq (i) = sumqv(i) + sumql(i) + sumqi(i) enddo do i=1,im @@ -5847,13 +5847,13 @@ subroutine moist_bud2(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & integer :: i, k ! do i=1,im - sumqv(i) = 0.0 - sumql(i) = 0.0 - sumqi(i) = 0.0 - sumqr(i) = 0.0 - sumqs(i) = 0.0 - sumqg(i) = 0.0 - sumq (i) = 0.0 + sumqv(i) = 0.0_kind_phys + sumql(i) = 0.0_kind_phys + sumqi(i) = 0.0_kind_phys + sumqr(i) = 0.0_kind_phys + sumqs(i) = 0.0_kind_phys + sumqg(i) = 0.0_kind_phys + sumq (i) = 0.0_kind_phys enddo do k=1,levs do i=1,im @@ -5865,7 +5865,7 @@ subroutine moist_bud2(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & sumqg(i) = sumqg(i) + (qg1(i,k) - qg0(i,k)) * delp(i,k) enddo enddo - oneog = 1.0 / grav + oneog = 1.0_kind_phys / grav do i=1,im sumqv(i) = - sumqv(i) * oneog sumql(i) = - sumql(i) * oneog From 83b6c40f57f3f10533793979767388c108e3ade0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 2 May 2020 23:34:16 +0000 Subject: [PATCH 047/217] some fix and some updates to atmos_model and ipd driver --- atmos_model.F90 | 22 ++++++++++++--------- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 10 +++++----- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index d2f65520c..a2da0dc5d 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1605,7 +1605,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 + real(kind=IPD_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice ! !------------------------------------------------------------------------------ @@ -1746,22 +1746,24 @@ subroutine assign_importdata(rc) findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then lcpl_fice = .true. -!$omp parallel do default(shared) private(i,j,nb,ix) +!$omp parallel do default(shared) private(i,j,nb,ix,ofrac) do j=jsc,jec do i=isc,iec 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 - IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(one, datar8(i,j)/IPD_Data(nb)%Sfcprop%oceanfrac(ix))) !LHS: ice frac wrt water area + ofrac = IPD_Data(nb)%Sfcprop%oceanfrac(ix) + if (ofrac > zero) then + IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area if (IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then if (IPD_Data(nb)%Coupling%ficein_cpl(ix) > one-epsln) IPD_Data(nb)%Coupling%ficein_cpl(ix) = one - if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4. +! if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points + IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys else IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero - if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then + if (abs(one-ofrac) < epsln) then IPD_Data(nb)%Sfcprop%slmsk(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero end if @@ -1955,8 +1957,10 @@ 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 (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) & - IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero ! 100% open water + if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then ! 100% open water + IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero + IPD_Data(nb)%Sfcprop%slmsk(ix) = zero + endif endif endif enddo diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index bfdf8f4b6..721fea81b 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1142,8 +1142,8 @@ subroutine GFS_physics_driver & endif if (fice(i) < one) then wet(i) = .true. ! some open ocean/lake water exists - if (.not. Model%cplflx .or. Sfcprop%oceanfrac(i) == zero) & - Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) + if ((.not. Model%cplflx .or. Sfcprop%oceanfrac(i) == zero) .and. icy(i)) & + Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif else fice(i) = zero @@ -1177,8 +1177,8 @@ subroutine GFS_physics_driver & endif if (fice(i) < one) then wet(i)=.true. ! some open ocean/lake water exists - if (.not. Model%cplflx) & - Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) + if (.not. Model%cplflx .and. icy(i)) & + Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif endif enddo @@ -2153,7 +2153,7 @@ subroutine GFS_physics_driver & Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) stress(i) = txi *stress3(i,2) + txo * stress3(i,3) qss(i) = txi * qss3(i,2) + txo * qss3(i,3) - ep1d(i) = txi * ep1d3(i,2) + txo * ep1d(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) From 638bda2199a6d3ad9bb7b292fe784743579e4235 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 4 May 2020 18:31:40 +0000 Subject: [PATCH 048/217] removed tisfcin_cpl and tseain_cpl as they are not needed --- atmos_model.F90 | 13 ++++++++----- gfsphysics/GFS_layer/GFS_typedefs.F90 | 12 ++++++------ 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 23010ea1e..c9aa82474 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1708,7 +1708,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) +! IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) + IPD_Data(nb)%Sfcprop%tisfc(ix) = datar8(i,j) endif enddo enddo @@ -1730,7 +1731,7 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) +! IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) IPD_Data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) endif enddo @@ -1938,14 +1939,15 @@ subroutine assign_importdata(rc) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then !if it is ocean or ice get surface temperature from mediator if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then - IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) +! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) 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) IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) else - IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) +! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) + IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Sfcprop%tsfco(ix) IPD_Data(nb)%Sfcprop%fice(ix) = zero IPD_Data(nb)%Sfcprop%hice(ix) = zero ! IPD_Data(nb)%Sfcprop%snowd(ix) = zero @@ -1976,7 +1978,8 @@ subroutine assign_importdata(rc) ! 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), & +!! ' tisfcin=',IPD_Data(nb)%Coupling%tisfcin_cpl(ix), & +! ' tisfcin=',IPD_Data(nb)%Sfcprop%tisfc(ix), & ! ' fice=',IPD_Data(nb)%Sfcprop%fice(ix) ! endif ! enddo diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index c2b64a544..ef569e83a 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -431,8 +431,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dtsfcin_cpl(:) => null() !< aoi_fld%dtsfcin(item,lan) real (kind=kind_phys), pointer :: dqsfcin_cpl(:) => null() !< aoi_fld%dqsfcin(item,lan) real (kind=kind_phys), pointer :: ulwsfcin_cpl(:)=> null() !< aoi_fld%ulwsfcin(item,lan) - real (kind=kind_phys), pointer :: tseain_cpl(:) => null() !< aoi_fld%tseain(item,lan) - real (kind=kind_phys), pointer :: tisfcin_cpl(:) => null() !< aoi_fld%tisfcin(item,lan) +! real (kind=kind_phys), pointer :: tseain_cpl(:) => null() !< aoi_fld%tseain(item,lan) +! real (kind=kind_phys), pointer :: tisfcin_cpl(:) => null() !< aoi_fld%tisfcin(item,lan) 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) @@ -2561,8 +2561,8 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dtsfcin_cpl (IM)) allocate (Coupling%dqsfcin_cpl (IM)) allocate (Coupling%ulwsfcin_cpl (IM)) - allocate (Coupling%tseain_cpl (IM)) - allocate (Coupling%tisfcin_cpl (IM)) +! allocate (Coupling%tseain_cpl (IM)) +! allocate (Coupling%tisfcin_cpl (IM)) allocate (Coupling%ficein_cpl (IM)) allocate (Coupling%hicein_cpl (IM)) allocate (Coupling%hsnoin_cpl (IM)) @@ -2573,8 +2573,8 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%dtsfcin_cpl = clear_val Coupling%dqsfcin_cpl = clear_val Coupling%ulwsfcin_cpl = clear_val - Coupling%tseain_cpl = clear_val - Coupling%tisfcin_cpl = clear_val +! Coupling%tseain_cpl = clear_val +! Coupling%tisfcin_cpl = clear_val Coupling%ficein_cpl = clear_val Coupling%hicein_cpl = clear_val Coupling%hsnoin_cpl = clear_val From 56a411196918229d76cc81a1bd171ab1ca4edee8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 10 May 2020 01:09:49 +0000 Subject: [PATCH 049/217] merged with fv3atm develop, tested the coupled model with nsst model turned on, removed a few unneeded arrays and some other updates --- atmos_model.F90 | 50 +++-- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 1 - gfsphysics/GFS_layer/GFS_typedefs.F90 | 22 +-- gfsphysics/physics/GFS_debug.F90 | 14 +- gfsphysics/physics/module_nst_model.f90 | 2 +- io/FV3GFS_io.F90 | 208 +++++++++++--------- 7 files changed, 164 insertions(+), 135 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index c9aa82474..97618c3ad 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -323,13 +323,19 @@ subroutine update_atmos_radiation_physics (Atmos) endif !--- if coupled, assign coupled fields + if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then -! print *,'in atmos_model,nblks=',Atm_block%nblks -! print *,'in atmos_model,IPD_Data size=',size(IPD_Data) -! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1) -! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc) + +! if (mpp_pe() == mpp_root_pe() .and. debug) then +! print *,'in atmos_model,nblks=',Atm_block%nblks +! print *,'in atmos_model,IPD_Data size=',size(IPD_Data) +! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1) +! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc) +! endif + call assign_importdata(rc) -! print *,'in atmos_model, after assign_importdata, rc=',rc + +! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in atmos_model, after assign_importdata, rc=',rc endif call mpp_clock_end(setupClock) @@ -1629,6 +1635,7 @@ subroutine assign_importdata(rc) found = .false. + isFieldCreated = ESMF_FieldIsCreated(importFields(n), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1639,6 +1646,8 @@ subroutine assign_importdata(rc) name=impfield_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',' n=',n,trim(impfield_name) + if ( dimCount == 2) then if ( datatype == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(importFields(n),farrayPtr=datar82d,localDE=0, rc=rc) @@ -1687,7 +1696,7 @@ subroutine assign_importdata(rc) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then tem = 100.0_IPD_kind_phys * max(zero, min(0.1_IPD_kind_phys, datar8(i,j))) - IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem +! IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem IPD_Data(nb)%Sfcprop%zorlo(ix) = tem endif @@ -1721,9 +1730,6 @@ subroutine assign_importdata(rc) fldname = 'sea_surface_temperature' if (trim(impfield_name) == trim(fldname)) then findex = QueryFieldList(ImportFieldsList,fldname) -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,' for sst', & -! ' fldname=',fldname,' findex=',findex,' importFieldsValid=',importFieldsValid(findex) - if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -1752,18 +1758,19 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero + + IPD_Data(nb)%Sfcprop%fice(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = IPD_Data(nb)%Sfcprop%slmsk(ix) ofrac = IPD_Data(nb)%Sfcprop%oceanfrac(ix) if (ofrac > zero) then - IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area - if (IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then - if (IPD_Data(nb)%Coupling%ficein_cpl(ix) > one-epsln) IPD_Data(nb)%Coupling%ficein_cpl(ix) = one + IPD_Data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area + if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then + if (IPD_Data(nb)%Sfcprop%fice(ix) > one-epsln) IPD_Data(nb)%Sfcprop%fice(ix) = one ! if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys else - IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero + IPD_Data(nb)%Sfcprop%fice(ix) = zero if (abs(one-ofrac) < epsln) then IPD_Data(nb)%Sfcprop%slmsk(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero @@ -1895,7 +1902,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) +! IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) + IPD_Data(nb)%Sfcprop%hice(ix) = datar8(i,j) endif enddo enddo @@ -1938,13 +1946,17 @@ subroutine assign_importdata(rc) ix = Atm_block%ixp(i,j) if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then !if it is ocean or ice get surface temperature from mediator - if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then + if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then + +! if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then ! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix) - IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) - IPD_Data(nb)%Sfcprop%hice(ix) = IPD_Data(nb)%Coupling%hicein_cpl(ix) +! IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix) +! 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) + IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & - / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) + / max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix)) +! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) else ! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Sfcprop%tsfco(ix) diff --git a/ccpp/physics b/ccpp/physics index 2b3448869..513cb29b7 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2b344886933a3c9978d992e41271bc3caef9eaf8 +Subproject commit 513cb29b7572d3246b6cf44e7c857ddfdb23c13f diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 708e8c6e8..1e9f42b93 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2104,7 +2104,6 @@ subroutine GFS_physics_driver & k = 2 stress(i) = stress3(i,2) ! Sfcprop%tprcp(i) = fice(i)*tprcp3(i,2) + (one-fice(i))*tprcp3(i,3) - if(Model%cplflx)Sfcprop%tsfcl(i) = tsfc3(i,2) ! for restart repro comparisons endif Sfcprop%zorl(i) = zorl3(i,k) cd(i) = cd3(i,k) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index ef569e83a..d70c0cc8e 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -433,11 +433,11 @@ module GFS_typedefs real (kind=kind_phys), pointer :: ulwsfcin_cpl(:)=> null() !< aoi_fld%ulwsfcin(item,lan) ! real (kind=kind_phys), pointer :: tseain_cpl(:) => null() !< aoi_fld%tseain(item,lan) ! real (kind=kind_phys), pointer :: tisfcin_cpl(:) => null() !< aoi_fld%tisfcin(item,lan) - 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 :: 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 cplwav2atm=.TRUE. - real (kind=kind_phys), pointer :: zorlwav_cpl(:) => null() !< roughness length from wave model +! 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) @@ -2546,12 +2546,12 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%v10mi_cpl = clear_val endif - if (Model%cplwav2atm) then +! if (Model%cplwav2atm) then !--- incoming quantities - allocate (Coupling%zorlwav_cpl (IM)) +! allocate (Coupling%zorlwav_cpl (IM)) - Coupling%zorlwav_cpl = clear_val - end if +! Coupling%zorlwav_cpl = clear_val +! end if if (Model%cplflx) then !--- incoming quantities @@ -2563,8 +2563,8 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%ulwsfcin_cpl (IM)) ! allocate (Coupling%tseain_cpl (IM)) ! allocate (Coupling%tisfcin_cpl (IM)) - allocate (Coupling%ficein_cpl (IM)) - allocate (Coupling%hicein_cpl (IM)) +! allocate (Coupling%ficein_cpl (IM)) +! allocate (Coupling%hicein_cpl (IM)) allocate (Coupling%hsnoin_cpl (IM)) Coupling%slimskin_cpl = clear_val @@ -2575,8 +2575,8 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%ulwsfcin_cpl = clear_val ! Coupling%tseain_cpl = clear_val ! Coupling%tisfcin_cpl = clear_val - Coupling%ficein_cpl = clear_val - Coupling%hicein_cpl = clear_val +! Coupling%ficein_cpl = clear_val +! Coupling%hicein_cpl = clear_val Coupling%hsnoin_cpl = clear_val !--- accumulated quantities diff --git a/gfsphysics/physics/GFS_debug.F90 b/gfsphysics/physics/GFS_debug.F90 index c0b24ca97..f4edecfaf 100644 --- a/gfsphysics/physics/GFS_debug.F90 +++ b/gfsphysics/physics/GFS_debug.F90 @@ -394,9 +394,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if - if (Model%cplwav2atm) then - call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) - end if +! if (Model%cplwav2atm) then +! call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) +! end if if (Model%cplflx) then call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) @@ -406,10 +406,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%dtsfcin_cpl ', Coupling%dtsfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dqsfcin_cpl ', Coupling%dqsfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) - call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl ) +! call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dusfc_cpl ', Coupling%dusfc_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dvsfc_cpl ', Coupling%dvsfc_cpl ) diff --git a/gfsphysics/physics/module_nst_model.f90 b/gfsphysics/physics/module_nst_model.f90 index f2b05c110..7154489f6 100644 --- a/gfsphysics/physics/module_nst_model.f90 +++ b/gfsphysics/physics/module_nst_model.f90 @@ -846,7 +846,7 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q zcsq = z_c * z_c a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - if ( hb > 0.0 ) then + if ( hb > 0.0 .and. zcsq > 0.0 .and. alpha > 0.0) then bc1 = zcsq * (q_ts+cc3*hl_ts) bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) zc_ts = bc1/bc2 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 7574f072b..5b67a4497 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -86,6 +86,7 @@ module FV3GFS_io_mod real(kind=kind_phys) :: zhour ! + integer, parameter :: r8 = kind_phys integer :: tot_diag_idx = 0 integer :: total_outputlevel = 0 integer :: isco,ieco,jsco,jeco,levo,num_axes_phys @@ -102,10 +103,10 @@ module FV3GFS_io_mod logical :: uwork_set = .false. character(128) :: uwindname integer, parameter, public :: DIAG_SIZE = 500 - real, parameter :: missing_value = 9.99e20 - real, parameter:: stndrd_atmos_ps = 101325. - real, parameter:: stndrd_atmos_lapse = 0.0065 - real, parameter:: drythresh = 1.e-4 + real, parameter :: missing_value = 9.99e20_r8 + real, parameter:: stndrd_atmos_ps = 101325.0_r8 + real, parameter:: stndrd_atmos_lapse = 0.0065_r8 + real, parameter:: drythresh = 1.e-4_r8, zero = 0.0_r8, one = 1.0_r8 !--- miscellaneous other variables logical :: use_wrtgridcomp_output = .FALSE. @@ -202,9 +203,9 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) - temp2d = 0. - temp3d = 0. - temp3dlevsp1 = 0. + temp2d = zero + temp3d = zero + temp3dlevsp1 = zero do j=jsc,jec do i=isc,iec @@ -378,16 +379,16 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) endif if (Model%nstf_name(1) > 0) then - temp2d(i,j,idx_opt) = IPD_Data(nb)%Sfcprop%tref(ix) - temp2d(i,j,idx_opt+1) = IPD_Data(nb)%Sfcprop%z_c(ix) - temp2d(i,j,idx_opt+2) = IPD_Data(nb)%Sfcprop%c_0(ix) - temp2d(i,j,idx_opt+3) = IPD_Data(nb)%Sfcprop%c_d(ix) - temp2d(i,j,idx_opt+4) = IPD_Data(nb)%Sfcprop%w_0(ix) - temp2d(i,j,idx_opt+5) = IPD_Data(nb)%Sfcprop%w_d(ix) - temp2d(i,j,idx_opt+6) = IPD_Data(nb)%Sfcprop%xt(ix) - temp2d(i,j,idx_opt+7) = IPD_Data(nb)%Sfcprop%xs(ix) - temp2d(i,j,idx_opt+8) = IPD_Data(nb)%Sfcprop%xu(ix) - temp2d(i,j,idx_opt+9) = IPD_Data(nb)%Sfcprop%xz(ix) + temp2d(i,j,idx_opt ) = IPD_Data(nb)%Sfcprop%tref(ix) + temp2d(i,j,idx_opt+ 1) = IPD_Data(nb)%Sfcprop%z_c(ix) + temp2d(i,j,idx_opt+ 2) = IPD_Data(nb)%Sfcprop%c_0(ix) + temp2d(i,j,idx_opt+ 3) = IPD_Data(nb)%Sfcprop%c_d(ix) + temp2d(i,j,idx_opt+ 4) = IPD_Data(nb)%Sfcprop%w_0(ix) + temp2d(i,j,idx_opt+ 5) = IPD_Data(nb)%Sfcprop%w_d(ix) + temp2d(i,j,idx_opt+ 6) = IPD_Data(nb)%Sfcprop%xt(ix) + temp2d(i,j,idx_opt+ 7) = IPD_Data(nb)%Sfcprop%xs(ix) + temp2d(i,j,idx_opt+ 8) = IPD_Data(nb)%Sfcprop%xu(ix) + temp2d(i,j,idx_opt+ 9) = IPD_Data(nb)%Sfcprop%xz(ix) temp2d(i,j,idx_opt+10) = IPD_Data(nb)%Sfcprop%zm(ix) temp2d(i,j,idx_opt+11) = IPD_Data(nb)%Sfcprop%xtts(ix) temp2d(i,j,idx_opt+12) = IPD_Data(nb)%Sfcprop%xzts(ix) @@ -512,8 +513,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) real(kind=kind_phys), dimension(-2:4) :: dzsnso real(kind=kind_phys), dimension(4), save :: zsoil,dzs - data dzs /0.1,0.3,0.6,1.0/ - data zsoil /-0.1,-0.4,-1.0,-2.0/ + data dzs /0.1_r8,0.3_r8,0.6_r8,1.0_r8/ + data zsoil /-0.1_r8,-0.4_r8,-1.0_r8,-2.0_r8/ if (Model%cplflx) then ! needs more variables @@ -670,16 +671,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp)) allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) #endif - sfc_var2 = -9999._kind_phys - sfc_var3 = -9999._kind_phys + sfc_var2 = -9999.0_r8 + sfc_var3 = -9999.0_r8 ! if (Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3sn(nx,ny,-2:0,4:6)) allocate(sfc_var3eq(nx,ny,1:4,7:7)) allocate(sfc_var3zn(nx,ny,-2:4,8:8)) - sfc_var3sn = -9999._kind_phys - sfc_var3eq = -9999._kind_phys - sfc_var3zn = -9999._kind_phys + sfc_var3sn = -9999.0_r8 + sfc_var3eq = -9999.0_r8 + sfc_var3zn = -9999.0_r8 end if !--- names of the 2D variables to save @@ -894,7 +895,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !coldstart(sfcfile doesn't include noah mp fields) or not if (Model%lsm == Model%lsm_noahmp) then - sfc_var2(1,1,nvar_s2m+19) = -66666. + sfc_var2(1,1,nvar_s2m+19) = -66666.0_r8 endif !--- read the surface restart/data @@ -951,54 +952,71 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if(Model%frac_grid) then ! obtain slmsk from landfrac !! next 5 lines are temporary till lake model is available - if (Sfcprop(nb)%lakefrac(ix) > 0.0) then + if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) - Sfcprop(nb)%landfrac(ix) = 1.-Sfcprop(nb)%lakefrac(ix) - if (Sfcprop(nb)%lakefrac(ix) == 0) Sfcprop(nb)%fice(ix)=0. + Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) + if (Sfcprop(nb)%lakefrac(ix) == zero) Sfcprop(nb)%fice(ix) = zero end if Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%fice(ix) > 0. .and. Sfcprop(nb)%landfrac(ix)==0.) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist + if (Sfcprop(nb)%fice(ix) > zero .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist else ! obtain landfrac from slmsk - if (Sfcprop(nb)%slmsk(ix) > 1.9) then - Sfcprop(nb)%landfrac(ix) = 0.0 + if (Sfcprop(nb)%slmsk(ix) > 1.9_r8) then + Sfcprop(nb)%landfrac(ix) = zero else Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) endif end if - if (Sfcprop(nb)%lakefrac(ix) > 0.0) then - Sfcprop(nb)%oceanfrac(ix) = 0.0 ! lake & ocean don't coexist in a cell - if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) Sfcprop(nb)%fice(ix) = 0. + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) Sfcprop(nb)%fice(ix) = zero else - Sfcprop(nb)%oceanfrac(ix) = 1.0 - Sfcprop(nb)%landfrac(ix) - if (Sfcprop(nb)%fice(ix) < Model%min_seaice) Sfcprop(nb)%fice(ix) = 0. + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (Sfcprop(nb)%fice(ix) < Model%min_seaice) Sfcprop(nb)%fice(ix) = zero endif ! !--- NSSTM variables - if ((Model%nstf_name(1) > 0) .and. (Model%nstf_name(2) == 1)) then + if (Model%nstf_name(1) > 0) then + if (Model%nstf_name(2) == 1) then ! nsst spinup !--- nsstm tref - Sfcprop(nb)%tref(ix) = Sfcprop(nb)%tsfco(ix) - Sfcprop(nb)%xz(ix) = 30.0d0 - endif - if ((Model%nstf_name(1) > 0) .and. (Model%nstf_name(2) == 0)) then - Sfcprop(nb)%tref(ix) = sfc_var2(i,j,nvar_s2m+1) !--- nsstm tref - Sfcprop(nb)%z_c(ix) = sfc_var2(i,j,nvar_s2m+2) !--- nsstm z_c - Sfcprop(nb)%c_0(ix) = sfc_var2(i,j,nvar_s2m+3) !--- nsstm c_0 - Sfcprop(nb)%c_d(ix) = sfc_var2(i,j,nvar_s2m+4) !--- nsstm c_d - Sfcprop(nb)%w_0(ix) = sfc_var2(i,j,nvar_s2m+5) !--- nsstm w_0 - Sfcprop(nb)%w_d(ix) = sfc_var2(i,j,nvar_s2m+6) !--- nsstm w_d - Sfcprop(nb)%xt(ix) = sfc_var2(i,j,nvar_s2m+7) !--- nsstm xt - Sfcprop(nb)%xs(ix) = sfc_var2(i,j,nvar_s2m+8) !--- nsstm xs - Sfcprop(nb)%xu(ix) = sfc_var2(i,j,nvar_s2m+9) !--- nsstm xu - Sfcprop(nb)%xv(ix) = sfc_var2(i,j,nvar_s2m+10) !--- nsstm xv - Sfcprop(nb)%xz(ix) = sfc_var2(i,j,nvar_s2m+11) !--- nsstm xz - Sfcprop(nb)%zm(ix) = sfc_var2(i,j,nvar_s2m+12) !--- nsstm zm - Sfcprop(nb)%xtts(ix) = sfc_var2(i,j,nvar_s2m+13) !--- nsstm xtts - Sfcprop(nb)%xzts(ix) = sfc_var2(i,j,nvar_s2m+14) !--- nsstm xzts - Sfcprop(nb)%d_conv(ix) = sfc_var2(i,j,nvar_s2m+15) !--- nsstm d_conv - Sfcprop(nb)%ifd(ix) = sfc_var2(i,j,nvar_s2m+16) !--- nsstm ifd - Sfcprop(nb)%dt_cool(ix) = sfc_var2(i,j,nvar_s2m+17) !--- nsstm dt_cool - Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain + Sfcprop(nb)%tref(ix) = Sfcprop(nb)%tsfco(ix) + Sfcprop(nb)%z_c(ix) = zero + Sfcprop(nb)%c_0(ix) = zero + Sfcprop(nb)%c_d(ix) = zero + Sfcprop(nb)%w_0(ix) = zero + Sfcprop(nb)%w_d(ix) = zero + Sfcprop(nb)%xt(ix) = zero + Sfcprop(nb)%xs(ix) = zero + Sfcprop(nb)%xu(ix) = zero + Sfcprop(nb)%xv(ix) = zero + Sfcprop(nb)%xz(ix) = 30.0_r8 + Sfcprop(nb)%zm(ix) = zero + Sfcprop(nb)%xtts(ix) = zero + Sfcprop(nb)%xzts(ix) = zero + Sfcprop(nb)%d_conv(ix) = zero + Sfcprop(nb)%ifd(ix) = zero + Sfcprop(nb)%dt_cool(ix) = zero + Sfcprop(nb)%qrain(ix) = zero + elseif (Model%nstf_name(2) == 0) then ! nsst restart + Sfcprop(nb)%tref(ix) = sfc_var2(i,j,nvar_s2m+1) !--- nsstm tref + Sfcprop(nb)%z_c(ix) = sfc_var2(i,j,nvar_s2m+2) !--- nsstm z_c + Sfcprop(nb)%c_0(ix) = sfc_var2(i,j,nvar_s2m+3) !--- nsstm c_0 + Sfcprop(nb)%c_d(ix) = sfc_var2(i,j,nvar_s2m+4) !--- nsstm c_d + Sfcprop(nb)%w_0(ix) = sfc_var2(i,j,nvar_s2m+5) !--- nsstm w_0 + Sfcprop(nb)%w_d(ix) = sfc_var2(i,j,nvar_s2m+6) !--- nsstm w_d + Sfcprop(nb)%xt(ix) = sfc_var2(i,j,nvar_s2m+7) !--- nsstm xt + Sfcprop(nb)%xs(ix) = sfc_var2(i,j,nvar_s2m+8) !--- nsstm xs + Sfcprop(nb)%xu(ix) = sfc_var2(i,j,nvar_s2m+9) !--- nsstm xu + Sfcprop(nb)%xv(ix) = sfc_var2(i,j,nvar_s2m+10) !--- nsstm xv + Sfcprop(nb)%xz(ix) = sfc_var2(i,j,nvar_s2m+11) !--- nsstm xz + Sfcprop(nb)%zm(ix) = sfc_var2(i,j,nvar_s2m+12) !--- nsstm zm + Sfcprop(nb)%xtts(ix) = sfc_var2(i,j,nvar_s2m+13) !--- nsstm xtts + Sfcprop(nb)%xzts(ix) = sfc_var2(i,j,nvar_s2m+14) !--- nsstm xzts + Sfcprop(nb)%d_conv(ix) = sfc_var2(i,j,nvar_s2m+15) !--- nsstm d_conv + Sfcprop(nb)%ifd(ix) = sfc_var2(i,j,nvar_s2m+16) !--- nsstm ifd + Sfcprop(nb)%dt_cool(ix) = sfc_var2(i,j,nvar_s2m+17) !--- nsstm dt_cool + Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain + endif endif #ifdef CCPP if (Model%lsm == Model%lsm_ruc .and. warm_start) then @@ -1140,15 +1158,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !--- code taken directly from read_fix.f do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%sncovr(ix) = 0.0 + Sfcprop(nb)%sncovr(ix) = zero if (Sfcprop(nb)%landfrac(ix) >= drythresh .or. Sfcprop(nb)%fice(ix) >= Model%min_seaice) then vegtyp = Sfcprop(nb)%vtype(ix) if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Sfcprop(nb)%weasd(ix)/snupx(vegtyp) - if (0.001*Sfcprop(nb)%weasd(ix) < snupx(vegtyp)) then - Sfcprop(nb)%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + rsnow = 0.001_r8*Sfcprop(nb)%weasd(ix)/snupx(vegtyp) + if (0.001_r8*Sfcprop(nb)%weasd(ix) < snupx(vegtyp)) then + Sfcprop(nb)%sncovr(ix) = one - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) else - Sfcprop(nb)%sncovr(ix) = 1.0 + Sfcprop(nb)%sncovr(ix) = one endif endif enddo @@ -1184,10 +1202,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) tem = (1.-Sfcprop(nb)%landfrac(ix)) * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & + Sfcprop(nb)%zorll(ix) * tem & !zorl ice = zorl land - + Sfcprop(nb)%zorlo(ix) * (1.-Sfcprop(nb)%landfrac(ix)-tem) + + Sfcprop(nb)%zorlo(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & + Sfcprop(nb)%tisfc(ix) * tem & - + Sfcprop(nb)%tsfco(ix) * (1.-Sfcprop(nb)%landfrac(ix)-tem) + + Sfcprop(nb)%tsfco(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) enddo enddo else @@ -1574,16 +1592,16 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp)) allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) #endif - sfc_var2 = -9999._kind_phys - sfc_var3 = -9999._kind_phys + sfc_var2 = -9999.0_r8 + sfc_var3 = -9999.0_r8 if (Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3sn(nx,ny,-2:0,4:6)) allocate(sfc_var3eq(nx,ny,1:4,7:7)) allocate(sfc_var3zn(nx,ny,-2:4,8:8)) - sfc_var3sn = -9999._kind_phys - sfc_var3eq = -9999._kind_phys - sfc_var3zn = -9999._kind_phys + sfc_var3sn = -9999.0_r8 + sfc_var3eq = -9999.0_r8 + sfc_var3zn = -9999.0_r8 endif @@ -1831,15 +1849,15 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta end if !--- NSSTM variables if (Model%nstf_name(1) > 0) then - sfc_var2(i,j,nvar2m+1) = Sfcprop(nb)%tref(ix) !--- nsstm tref - sfc_var2(i,j,nvar2m+2) = Sfcprop(nb)%z_c(ix) !--- nsstm z_c - sfc_var2(i,j,nvar2m+3) = Sfcprop(nb)%c_0(ix) !--- nsstm c_0 - sfc_var2(i,j,nvar2m+4) = Sfcprop(nb)%c_d(ix) !--- nsstm c_d - sfc_var2(i,j,nvar2m+5) = Sfcprop(nb)%w_0(ix) !--- nsstm w_0 - sfc_var2(i,j,nvar2m+6) = Sfcprop(nb)%w_d(ix) !--- nsstm w_d - sfc_var2(i,j,nvar2m+7) = Sfcprop(nb)%xt(ix) !--- nsstm xt - sfc_var2(i,j,nvar2m+8) = Sfcprop(nb)%xs(ix) !--- nsstm xs - sfc_var2(i,j,nvar2m+9) = Sfcprop(nb)%xu(ix) !--- nsstm xu + sfc_var2(i,j,nvar2m+1) = Sfcprop(nb)%tref(ix) !--- nsstm tref + sfc_var2(i,j,nvar2m+2) = Sfcprop(nb)%z_c(ix) !--- nsstm z_c + sfc_var2(i,j,nvar2m+3) = Sfcprop(nb)%c_0(ix) !--- nsstm c_0 + sfc_var2(i,j,nvar2m+4) = Sfcprop(nb)%c_d(ix) !--- nsstm c_d + sfc_var2(i,j,nvar2m+5) = Sfcprop(nb)%w_0(ix) !--- nsstm w_0 + sfc_var2(i,j,nvar2m+6) = Sfcprop(nb)%w_d(ix) !--- nsstm w_d + sfc_var2(i,j,nvar2m+7) = Sfcprop(nb)%xt(ix) !--- nsstm xt + sfc_var2(i,j,nvar2m+8) = Sfcprop(nb)%xs(ix) !--- nsstm xs + sfc_var2(i,j,nvar2m+9) = Sfcprop(nb)%xu(ix) !--- nsstm xu sfc_var2(i,j,nvar2m+10) = Sfcprop(nb)%xv(ix) !--- nsstm xv sfc_var2(i,j,nvar2m+11) = Sfcprop(nb)%xz(ix) !--- nsstm xz sfc_var2(i,j,nvar2m+12) = Sfcprop(nb)%zm(ix) !--- nsstm zm @@ -2015,8 +2033,8 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) allocate (phy_var3(nx,ny,npz,nvar3d)) - phy_var2 = 0.0_kind_phys - phy_var3 = 0.0_kind_phys + phy_var2 = zero + phy_var3 = zero do num = 1,nvar2d var2_p => phy_var2(:,:,num) @@ -2060,7 +2078,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 - IPD_Restart%data(nb,num)%var2p(ix) = 0. + IPD_Restart%data(nb,num)%var2p(ix) = zero enddo enddo enddo @@ -2120,8 +2138,8 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) allocate (phy_var3(nx,ny,npz,nvar3d)) - phy_var2 = 0.0_kind_phys - phy_var3 = 0.0_kind_phys + phy_var2 = zero + phy_var3 = zero do num = 1,nvar2d var2_p => phy_var2(:,:,num) @@ -2273,9 +2291,9 @@ subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) allocate(buffer_phys_bl(isco:ieco,jsco:jeco,nrgst_bl)) allocate(buffer_phys_nb(isco:ieco,jsco:jeco,nrgst_nb)) allocate(buffer_phys_windvect(3,isco:ieco,jsco:jeco,nrgst_vctbl)) - buffer_phys_bl = 0. - buffer_phys_nb = 0. - buffer_phys_windvect = 0. + buffer_phys_bl = zero + buffer_phys_nb = zero + buffer_phys_windvect = zero if(mpp_pe() == mpp_root_pe()) print *,'in fv3gfs_diag_register, nrgst_bl=',nrgst_bl,' nrgst_nb=',nrgst_nb, & ' nrgst_vctbl=',nrgst_vctbl, 'isco=',isco,ieco,'jsco=',jsco,jeco,' num_axes_phys=', num_axes_phys @@ -2316,11 +2334,11 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & logical :: used nblks = atm_block%nblks - rdt = 1.0d0/dt - rtime_int = 1.0d0/time_int - rtime_intfull = 1.0d0/time_intfull - rtime_radsw = 1.0d0/time_radsw - rtime_radlw = 1.0d0/time_radlw + rdt = one/dt + rtime_int = one/time_int + rtime_intfull = one/time_intfull + rtime_radsw = one/time_radsw + rtime_radlw = one/time_radlw isc = atm_block%isc jsc = atm_block%jsc @@ -2619,7 +2637,7 @@ subroutine store_data(id, work, Time, idx, intpl_method, fldname) enddo enddo endif - uwork = 0.0 + uwork = zero uwindname = '' uwork_set = .false. endif @@ -2720,7 +2738,7 @@ subroutine store_data3D(id, work, Time, idx, intpl_method, fldname) enddo deallocate (sinlon, coslon, sinlat, coslat) endif - uwork3d = 0. + uwork3d = zero uwindname = '' uwork_set = .false. endif From 29a132990d7866ffed6dd3a1a6be45bf191a8b18 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 10 May 2020 01:11:32 +0000 Subject: [PATCH 050/217] Adding a new suite suite_FV3_GFS_cpld_rasmgshocnsst.xml --- .../suite_FV3_GFS_cpld_rasmgshocnsst.xml | 90 +++++++++++++++++++ 1 file changed, 90 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml new file mode 100644 index 000000000..5b3b63528 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 04412367cf671ab6e757126f02078c13dd6d094e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 11 May 2020 18:46:48 +0000 Subject: [PATCH 051/217] updating submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 513cb29b7..3cdcdaab7 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 513cb29b7572d3246b6cf44e7c857ddfdb23c13f +Subproject commit 3cdcdaab7261ffb212e0c36b6eeff34880429cb4 From 2e9d571c1f2275a10be2b87d1f427bd277f62ffc Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 18 May 2020 21:04:57 -0400 Subject: [PATCH 052/217] updating nst model when coupled with ocean for IPD --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 27 +++-- gfsphysics/physics/module_nst_water_prop.f90 | 112 +++++++++---------- 3 files changed, 67 insertions(+), 74 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 3cdcdaab7..4c08f739c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3cdcdaab7261ffb212e0c36b6eeff34880429cb4 +Subproject commit 4c08f739c121af21483e832cd29b4f3d34c9361e diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 1e9f42b93..3e78990c3 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -59,7 +59,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: con_p001= 0.001_kind_phys real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi - real(kind=kind_phys), parameter :: omz1 = 10.0_kind_phys + real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys real(kind=kind_phys), parameter :: huge = zero !> GFS Physics Implementation Layer @@ -515,6 +515,7 @@ subroutine GFS_physics_driver & stress, t850, ep1d, gamt, gamq, sigmaf, & wind, work1, work2, work3, work4, runof, xmu, fm10, fh2, & tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,& +! dnsst, tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,& snowc, frland, adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, & adjnirdfd, adjvisbmd, adjvisdfd, xcosz, tseal, & @@ -1709,24 +1710,26 @@ subroutine GFS_physics_driver & endif enddo if (Model%cplflx) then ! apply only at ocean points - tem1 = half / omz1 + call get_dtzm_2d (Sfcprop%xt, Sfcprop%xz, Sfcprop%dt_cool, & + Sfcprop%z_c, wet, zero, omz1, im, 1, dtzm) do i=1,im 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 - Sfcprop%tref(i) = tseal(i) - (one-half*omz1*tem2) * dt_warm & - + Sfcprop%z_c(i)*Sfcprop%dt_cool(i)*tem1 +! dnsst = tsfc3(i,3) - Sfcprop%tref(i) ! retrive/get difference of Ts and Tf + Sfcprop%tref(i) = Sfcprop%tsfco(i) - dtzm(i) ! update Tf with T1 and NSST T-Profile +! tsfc3(i,3) = max(271.2,Sfcprop%tref(i) + dnsst ! get Ts updated due to Tf update +! tseal(i) = tsfc3(i,3) + if (abs(Sfcprop%xz(i)) > zero) then + tem2 = one / Sfcprop%xz(i) else - Sfcprop%tref(i) = tseal(i) - (Sfcprop%xz(i)*dt_warm & - - Sfcprop%z_c(i)*Sfcprop%dt_cool(i))*tem1 + tem2 = zero endif - TSEAl(i) = Sfcprop%tref(i) + dt_warm - Sfcprop%dt_cool(i) -! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i))*rlapse - tsurf3(i,3) = TSEAl(i) + tseal(i) = Sfcprop%tref(i) + (Sfcprop%xt(i)+Sfcprop%xt(i)) * tem2 & + - Sfcprop%dt_cool(i) + tsurf3(i,3) = tseal(i) endif enddo endif + ! if (lprnt) write(0,*)' bef nst tseal=',tseal(ipr) & ! ,' tsfc3=',tsfc3(ipr,3),' tsurf3=',tsurf3(ipr,3),' tem=',tem !*## CCPP ## diff --git a/gfsphysics/physics/module_nst_water_prop.f90 b/gfsphysics/physics/module_nst_water_prop.f90 index 36a699ede..ffc7f4896 100644 --- a/gfsphysics/physics/module_nst_water_prop.f90 +++ b/gfsphysics/physics/module_nst_water_prop.f90 @@ -5,7 +5,7 @@ module module_nst_water_prop private public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d - + ! interface sw_ps_9b module procedure sw_ps_9b @@ -37,7 +37,7 @@ module module_nst_water_prop subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ - ! compute thermal expansion coefficient (alpha) + ! compute thermal expansion coefficient (alpha) ! and saline contraction coefficient (beta) using ! the international equation of state of sea water ! (1980). ref: pond and pickard, introduction to @@ -45,26 +45,26 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) ! note: compression effects are not included implicit none - real(kind=kind_phys), intent(in) :: t, s, rhoref - real(kind=kind_phys), intent(out) :: alpha, beta + real(kind=kind_phys), intent(in) :: t, s, rhoref + real(kind=kind_phys), intent(out) :: alpha, beta real(kind=kind_phys) :: tc tc = t - t0k - alpha = & - 6.793952e-2 & - - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & - - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & - - 4.0899e-3 * s & - + 2.0 * 7.6438e-5 * tc * s - 3.0 * 8.2467e-7 * tc**2 * s & - + 4.0 * 5.3875e-9 * tc**3 * s & + alpha = & + 6.793952e-2 & + - 2.0 * 9.095290e-3 * tc + 3.0 * 1.001685e-4 * tc**2 & + - 4.0 * 1.120083e-6 * tc**3 + 5.0 * 6.536332e-9 * tc**4 & + - 4.0899e-3 * s & + + 2.0 * 7.6438e-5 * tc * s - 3.0 * 8.2467e-7 * tc**2 * s & + + 4.0 * 5.3875e-9 * tc**3 * s & + 1.0227e-4 * s**1.5 - 2.0 * 1.6546e-6 * tc * s**1.5 ! note: rhoref - specify ! alpha = -alpha/rhoref - beta = & + beta = & 8.24493e-1 - 4.0899e-3 * tc & + 7.6438e-5 * tc**2 - 8.2467e-7 * tc**3 & + 5.3875e-9 * tc**4 - 1.5 * 5.72466e-3 * s**.5 & @@ -84,13 +84,13 @@ subroutine density(t, s, rho) real(kind=kind_phys), intent(in) :: t !unit, k real(kind=kind_phys), intent(in) :: s !unit, 1/1000 ! output - real(kind=kind_phys), intent(out) :: rho !unit, kg/m^3 + real(kind=kind_phys), intent(out) :: rho !unit, kg/m^3 ! local real(kind=kind_phys) :: tc - ! compute density using the international equation - ! of state of sea water 1980, (pond and pickard, - ! introduction to dynamical oceanography, pp310). + ! compute density using the international equation + ! of state of sea water 1980, (pond and pickard, + ! introduction to dynamical oceanography, pp310). ! compression effects are not included rho = 0.0 @@ -114,7 +114,7 @@ end subroutine density ! elemental subroutine sw_ps_9b(z,fxp) ! - ! fraction of the solar radiation absorbed by the ocean at the depth z + ! fraction of the solar radiation absorbed by the ocean at the depth z ! following paulson and simpson, 1981 ! ! input: @@ -146,7 +146,7 @@ end subroutine sw_ps_9b ! elemental subroutine sw_ps_9b_aw(z,aw) ! - ! d(fw)/d(z) for 9-band + ! d(fw)/d(z) for 9-band ! ! input: ! z: depth (m) @@ -297,8 +297,8 @@ end subroutine sw_fairall_simple_v1 elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (zeng and beljaars, 2005, p.5) - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -324,7 +324,7 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) ! following soloviev, 1982 ! - ! input: + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -353,8 +353,8 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) ! following soloviev, 1982 - ! - ! input: + ! + ! input: ! f_sol_0: solar radiation at the ocean surface (w/m^2) ! z: depth (m) ! @@ -367,8 +367,8 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! if(z>0) then df_sol_z=f_sol_0*(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - +0.27*0.357*(1.-exp(-z/0.357)) & + -(0.28*0.014*(1.-exp(-z/0.014)) & + +0.27*0.357*(1.-exp(-z/0.357)) & +.45*12.82*(1.-exp(-z/12.82)))/z & ) else @@ -440,7 +440,7 @@ function grv(lat) c3=0.0000001262 c4=0.0000000007 pi=3.141593 - + phi=lat*pi/180 x=sin(phi) grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) @@ -490,7 +490,7 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) ! jmnth - month ! jday - day ! jhr - hour -! jmn - minutes +! jmn - minutes ! output argument list: ! jd - julian day. ! fjd - fraction of the julian day. @@ -642,66 +642,56 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,dtm) real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm ! Local variables integer :: i,j - real (kind=kind_phys), dimension(nx,ny) :: dtw,dtc - real (kind=kind_phys) :: dt_warm + real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi + real (kind=kind_phys), parameter :: zero=0.0, half=0.5, one=1.0 -!$omp parallel do private(j,i) +!$omp parallel do private(j,i,dtw,dtc,xzi) do j = 1, ny do i= 1, nx -! -! initialize dtw & dtc as zeros -! - dtw(i,j) = 0.0 - dtc(i,j) = 0.0 -! if ( wet(i,j) .and. .not.icy(i,j) ) then + + dtm(i,j) = zero ! initialize dtm + if ( wet(i,j) ) then ! ! get the mean warming in the range of z=z1 to z=z2 ! - if ( xt(i,j) > 0.0 ) then - dt_warm = (xt(i,j)+xt(i,j))/xz(i,j) ! Tw(0) - if ( z1 < z2) then + dtw = zero + if ( xt(i,j) > zero ) then + xzi = one / xz(i,j) + dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) + if (z1 < z2) then if ( z2 < xz(i,j) ) then - dtw(i,j) = dt_warm*(1.0-(z1+z2)/(xz(i,j)+xz(i,j))) - elseif ( z1 < xz(i,j) .and. z2 >= xz(i,j) ) then - dtw(i,j) = 0.5*(1.0-z1/xz(i,j))*dt_warm*(xz(i,j)-z1)/(z2-z1) + dtw = dt_warm * (one-half*(z1+z2)*xzi) + elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then + dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) endif - elseif ( z1 == z2 ) then - if ( z1 < xz(i,j) ) then - dtw(i,j) = dt_warm*(1.0-z1/xz(i,j)) + elseif (z1 == z2 ) then + if (z1 < xz(i,j) ) then + dtw = dt_warm * (one-z1*xzi) endif endif endif ! ! get the mean cooling in the range of z=0 to z=zsea ! - if ( zc(i,j) > 0.0 ) then + dtc = zero + if ( zc(i,j) > zero ) then if ( z1 < z2) then if ( z2 < zc(i,j) ) then - dtc(i,j) = dt_cool(i,j)*(1.0-(z1+z2)/(zc(i,j)+zc(i,j))) + dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then - dtc(i,j) = 0.5*(1.0-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) + dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < zc(i,j) ) then - dtc(i,j) = dt_cool(i,j)*(1.0-z1/zc(i,j)) + dtc = dt_cool(i,j) * (one-z1/zc(i,j)) endif endif endif - endif ! if ( wet(i,j) .and. .not.icy(i,j) ) then - enddo - enddo -! ! get the mean T departure from Tf in the range of z=z1 to z=z2 - -!$omp parallel do private(j,i) - do j = 1, ny - do i= 1, nx -! if ( wet(i,j) .and. .not.icy(i,j)) then - if ( wet(i,j) ) then - dtm(i,j) = dtw(i,j) - dtc(i,j) - endif + dtm(i,j) = dtw - dtc + endif ! if ( wet(i,j)) then enddo enddo From 8f6219475564319cd86e3b566b040c433358198a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 26 May 2020 15:49:49 -0400 Subject: [PATCH 053/217] updating gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 02895d59a..c563e5247 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Apr282020 + branch = SM_May202020 From f79ebe2297d47f9223a14304048d1eb79568de08 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 27 May 2020 20:16:39 -0400 Subject: [PATCH 054/217] some fix related to ice in surface cycling in IPD --- ccpp/physics | 2 +- gfsphysics/physics/gcycle.F90 | 30 +++++++++--------- gfsphysics/physics/sfcsub.F | 57 ++++++++++++++++++++--------------- 3 files changed, 48 insertions(+), 41 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 760e9eabb..d810799b6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 760e9eabb5610d3bd39465620553d2a7bd0f213e +Subproject commit d810799b637173f14360bad7727ef9f05a0351ba diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 654c8ab93..f7dae4881 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -77,22 +77,22 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) len = 0 do jx = Model%jsc, (Model%jsc+Model%ny-1) - do ix = Model%isc, (Model%isc+Model%nx-1) - len = len + 1 - i_index(len) = ix - j_index(len) = jx - enddo + do ix = Model%isc, (Model%isc+Model%nx-1) + len = len + 1 + i_index(len) = ix + j_index(len) = jx + enddo enddo - sig1t = 0.0 + sig1t = 0.0_kind_phys npts = Model%nx*Model%ny ! len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 - RLA (len) = Grid(nb)%xlat (ix) * pifac - RLO (len) = Grid(nb)%xlon (ix) * pifac + RLA (len) = Grid(nb)%xlat (ix) * pifac + RLO (len) = Grid(nb)%xlon (ix) * pifac OROG (len) = Sfcprop(nb)%oro (ix) OROG_UF (len) = Sfcprop(nb)%oro_uf (ix) SLIFCS (len) = Sfcprop(nb)%slmsk (ix) @@ -135,18 +135,18 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%slc (ix,ls) enddo - IF (SLIFCS(len) .LT. 0.1 .OR. SLIFCS(len) .GT. 1.5) THEN - SLMASK(len) = 0 + IF (SLIFCS(len) < 0.1_kind_phys .OR. SLIFCS(len) > 1.5_kind_phys) THEN + SLMASK(len) = 0.0_kind_phys ELSE - SLMASK(len) = 1 + SLMASK(len) = 1.0_kind_phys ENDIF - IF (SLIFCS(len) .EQ. 2) THEN - AISFCS(len) = 1. + IF (SLIFCS(len) > 1.99_kind_phys) THEN + AISFCS(len) = 1.0_kind_phys ELSE - AISFCS(len) = 0. + AISFCS(len) = 0.0_kind_phys ENDIF - if (Sfcprop(nb)%lakefrac(ix) > 0.0) then + if (Sfcprop(nb)%lakefrac(ix) > 0.0_kind_phys) then lake(len) = .true. else lake(len) = .false. diff --git a/gfsphysics/physics/sfcsub.F b/gfsphysics/physics/sfcsub.F index f3291e892..d3e94943b 100644 --- a/gfsphysics/physics/sfcsub.F +++ b/gfsphysics/physics/sfcsub.F @@ -2397,7 +2397,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & do j = 1,lsoil do i = 1,len smcfcs(i,j) = smcanl(i,j) - if (slifcs(i) .gt. 0.0) then + if (slifcs(i) > 0.0_kind_io8) then stcfcs(i,j) = stcanl(i,j) else stcfcs(i,j) = tsffcs(i) @@ -2416,7 +2416,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !cwu [+20l] update sihfcs, sicfcs. remove sea ice over non-ice points -! crit=aislim +! crit = aislim do i=1,len sihfcs(i) = sihanl(i) sitfcs(i) = tsffcs(i) @@ -2425,38 +2425,46 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & else crit = min_seaice endif - if (slifcs(i) >= 2.) then + if (slifcs(i) >= 1.99_kind_io8) then if (sicfcs(i) > crit) then - tem1 = 1.0 / sicfcs(i) + tem1 = 1.0_kind_io8 / sicfcs(i) tsffcs(i) = (sicanl(i)*tsffcs(i) & + (sicfcs(i)-sicanl(i))*tgice) * tem1 sitfcs(i) = (tsffcs(i)-tgice*(1.0-sicfcs(i))) * tem1 + sicfcs(i) = sicanl(i) else tsffcs(i) = tsfanl(i) ! tsffcs(i) = tgice - sihfcs(i) = sihnew +! sihfcs(i) = sihnew + sihfcs(i) = 0.0_kind_io8 + sicfcs(i) = 0.0_kind_io8 + slifcs(i) = 0.0_kind_io8 endif endif - sicfcs(i) = sicanl(i) - enddo - do i=1,len - if (slifcs(i) < 1.5) then - sihfcs(i) = 0. - sicfcs(i) = 0. - sitfcs(i) = tsffcs(i) - else - if (lake(i)) then - crit = min_lakeice - else - crit = min_seaice - endif - if (sicfcs(i) < crit) then + if (slifcs(i) > 1.5_kind_io8 .and. sicfcs(i) < crit) then print *,'warning: check, slifcs and sicfcs', & & slifcs(i),sicfcs(i) - endif endif enddo +! do i=1,len +! if (slifcs(i) < 1.5_kind_io8) then +! sihfcs(i) = 0.0_kind_io8 +! sicfcs(i) = 0.0_kind_io8 +! sitfcs(i) = tsffcs(i) +! else +! if (lake(i)) then +! crit = min_lakeice +! else +! crit = min_seaice +! endif +! if (sicfcs(i) < crit) then +! print *,'warning: check, slifcs and sicfcs', & +! & slifcs(i),sicfcs(i) +! endif +! endif +! enddo + ! ! ensure the consistency between slc and smc ! @@ -7215,8 +7223,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & kpd7=-1 if (ialb == 1) then -!cbosu still need facsf and facwf. read them from the production -!cbosu file +!cbosu still need facsf and facwf. read them from the production file if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask &, alf,len,iret @@ -8023,8 +8030,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & return end subroutine clima subroutine fixrdc_tile(filename_raw, tile_num_ch, & - & i_index, j_index, kpds, & - & var, mon, npts, me) + & i_index, j_index, kpds, var, mon, npts, me) use netcdf use machine , only : kind_io8 implicit none @@ -8041,7 +8047,8 @@ subroutine fixrdc_tile(filename_raw, tile_num_ch, & integer :: nx, ny, num_times integer :: id_var real(kind=4), allocatable :: dummy(:,:,:) - ii=index(filename_raw,"tileX") + + ii = index(filename_raw,"tileX") do i = 1, len(filename) filename(i:i) = " " From 4ace2edbb0cc62d27f2dfaf907a344eab422ebcb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 14 Jun 2020 23:54:01 +0000 Subject: [PATCH 055/217] some update to fv3_io and updte to ipd side of sfc_diff for when coupled to wave model --- ccpp/physics | 2 +- gfsphysics/physics/sfc_diff.f | 20 +++++++++---- io/FV3GFS_io.F90 | 54 ++++++++++++++++++++++++----------- 3 files changed, 53 insertions(+), 23 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index d810799b6..8b77f3694 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d810799b637173f14360bad7727ef9f05a0351ba +Subproject commit 8b77f369475e949bc1735c33e340a97d09f59c82 diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index 77bac2819..691483f94 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -264,18 +264,28 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) if (redrag) then z0rl(i,3) = 100.0d0 * max(min(z0, z0s_max), 1.0d-7) else - z0rl(i,3) = 100.0d0 * max(min(z0,0.1d0), 1.0d-7) + z0rl(i,3) = 100.0d0 * max(min(z0, 0.1d0), 1.0d-7) endif elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl(i,3) = 100.0d0 * z0 ! cm + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl(i,3) = 100.0d0 * z0 ! cm elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl(i,3) = 100.0d0 * z0 ! cm + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl(i,3) = 100.0d0 * z0 ! cm else z0rl(i,3) = 1.0d-4 endif + + elseif (z0rl(i,3) <= 0.0d0) then + z0 = (charnock / grav) * ustar(i,3) * ustar(i,3) + + if (redrag) then + z0rl(i,3) = 100.0d0 * max(min(z0, z0s_max), 1.0d-7) + else + z0rl(i,3) = 100.0d0 * max(min(z0, 0.1d0), 1.0d-70) + endif + endif endif ! end of if(open ocean) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 5b67a4497..9f67c9b4e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -513,15 +513,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) real(kind=kind_phys), dimension(-2:4) :: dzsnso real(kind=kind_phys), dimension(4), save :: zsoil,dzs - data dzs /0.1_r8,0.3_r8,0.6_r8,1.0_r8/ + data dzs / 0.1_r8, 0.3_r8, 0.6_r8, 1.0_r8/ data zsoil /-0.1_r8,-0.4_r8,-1.0_r8,-2.0_r8/ - - if (Model%cplflx) then ! needs more variables - nvar_s2m = 34 - else - nvar_s2m = 32 - endif nvar_o2 = 19 nvar_s2o = 18 #ifdef CCPP @@ -605,6 +599,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Model%frac_grid = .false. !--- copy data into GFS containers + +!$omp parallel do default(shared) private(i, j, nb, ix) do nb = 1, Atm_block%nblks !--- 2D variables do ix = 1, Atm_block%blksz(nb) @@ -645,6 +641,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Model%frac_grid = .true. endif + if (Model%cplflx .or. Model%frac_grid) then ! needs more variables + nvar_s2m = 34 + else + nvar_s2m = 32 + endif + if (Model%me == Model%master ) write(0,*)' resetting Model%frac_grid=',Model%frac_grid !--- deallocate containers and free restart container @@ -671,8 +673,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp)) allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) #endif - sfc_var2 = -9999.0_r8 - sfc_var3 = -9999.0_r8 + sfc_var2 = -9999.0_r8 + sfc_var3 = -9999.0_r8 ! if (Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3sn(nx,ny,-2:0,4:6)) @@ -906,6 +908,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) ! write(0,*)' sfc_var2=',sfc_var2(:,:,12) !--- place the data into the block GFS containers + +!$omp parallel do default(shared) private(i, j, nb, ix, lsoil) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 @@ -945,7 +949,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%slope(ix) = sfc_var2(i,j,30) !--- slope Sfcprop(nb)%snoalb(ix) = sfc_var2(i,j,31) !--- snoalb Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr - if(Model%cplflx) then + if(Model%cplflx .or. Model%frac_grid) then Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) end if @@ -1151,11 +1155,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) ! in the FV3/non-CCPP physics when the CCPP-enabled executable is built. #endif !#ifndef CCPP + + i = Atm_block%index(1)%ii(1) - isc + 1 + j = Atm_block%index(1)%jj(1) - jsc + 1 + !--- if sncovr does not exist in the restart, need to create it - if (nint(sfc_var2(1,1,32)) == -9999) then + if (sfc_var2(i,j,32) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr') !--- compute sncovr from existing variables !--- code taken directly from read_fix.f +!$omp parallel do default(shared) private(nb, ix, vegtyp, rsnow) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) Sfcprop(nb)%sncovr(ix) = zero @@ -1173,9 +1182,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo endif - if(Model%cplflx .or. Model%frac_grid) then - if (nint(sfc_var2(1,1,33)) == -9999) then + if (Model%cplflx .or. Model%frac_grid) then + + if (sfc_var2(i,j,33) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') +!$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) !--- compute tsfcl from existing variables @@ -1183,8 +1194,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo endif - if (nint(sfc_var2(1,1,34)) == -9999) then + if (sfc_var2(i,j,34) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') +!$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) !--- compute zorll from existing variables @@ -1196,19 +1208,21 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !#endif if(Model%frac_grid) then ! 3-way composite +!$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) - tem = (1.-Sfcprop(nb)%landfrac(ix)) * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell + tem = (one-Sfcprop(nb)%landfrac(ix)) * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%zorll(ix) * tem & !zorl ice = zorl land + + Sfcprop(nb)%zorll(ix) * tem & !zorl ice = zorl land + Sfcprop(nb)%zorlo(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%tisfc(ix) * tem & + + Sfcprop(nb)%tisfc(ix) * tem & + Sfcprop(nb)%tsfco(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) enddo enddo else +!$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) !--- specify tsfcl/zorll from existing variable tsfco/zorlo @@ -1806,6 +1820,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif +!$omp parallel do default(shared) private(i, j, nb, ix, lsoil) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) !--- 2D variables @@ -2062,6 +2077,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) !--- place the data into the block GFS containers !--- phy_var* variables +!$omp parallel do default(shared) private(i, j, nb, ix) do num = 1,nvar2d do nb = 1,Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -2074,6 +2090,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) !-- if restart from init time, reset accumulated diag fields if( Model%phour < 1.e-7) then do num = fdiag,ldiag +!$omp parallel do default(shared) private(i, j, nb, ix) do nb = 1,Atm_block%nblks do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 @@ -2084,6 +2101,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) enddo endif do num = 1,nvar3d +!$omp parallel do default(shared) private(i, j, k, nb, ix) do nb = 1,Atm_block%nblks do k=1,npz do ix = 1, Atm_block%blksz(nb) @@ -2156,6 +2174,7 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta endif !--- 2D variables +!$omp parallel do default(shared) private(i, j, num, nb, ix) do num = 1,nvar2d do nb = 1,Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -2166,6 +2185,7 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta enddo enddo !--- 3D variables +!$omp parallel do default(shared) private(i, j, k, num, nb, ix) do num = 1,nvar3d do nb = 1,Atm_block%nblks do k=1,npz From 8e977b4b0793a0ff44af39fd047bfc71d6d64be6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 17 Jun 2020 23:22:59 +0000 Subject: [PATCH 056/217] reverting in atmos_model.F90 mytile instead of mygrid to use with older FMS and dycore --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 3ff1ed2ad..15c615f80 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 3ff1ed2adb10bbe892c9d9d010bb5b11c66ce425 +Subproject commit 15c615f80e745848d0af50a47174e7c6dc851236 diff --git a/atmos_model.F90 b/atmos_model.F90 index 9eda63545..ef62c3c5b 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -78,7 +78,7 @@ module atmos_model_mod use atmosphere_mod, only: atmosphere_scalar_field_halo use atmosphere_mod, only: atmosphere_get_bottom_layer use atmosphere_mod, only: set_atmosphere_pelist -use atmosphere_mod, only: Atm, mygrid +use atmosphere_mod, only: Atm, mytile use block_control_mod, only: block_control_type, define_blocks_packed use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type #ifdef CCPP @@ -610,8 +610,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%area => Atmos%area Init_parm%tracer_names => tracer_names #ifdef CCPP - Init_parm%restart = Atm(mygrid)%flagstruct%warm_start - Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic + Init_parm%restart = Atm(mytile)%flagstruct%warm_start + Init_parm%hydrostatic = Atm(mytile)%flagstruct%hydrostatic #endif #ifdef INTERNAL_FILE_NML @@ -683,7 +683,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) endif endif - Atm(mygrid)%flagstruct%do_skeb = IPD_Control%do_skeb + Atm(mytile)%flagstruct%do_skeb = IPD_Control%do_skeb ! initialize the IAU module call iau_initialize (IPD_Control,IAU_data,Init_parm) @@ -704,7 +704,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call FV3GFS_diag_register (IPD_Diag, Time, Atm_block, IPD_Control, Atmos%lon, Atmos%lat, Atmos%axes) call IPD_initialize_rst (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) #ifdef CCPP - call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) + call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain, Atm(mytile)%flagstruct%warm_start) #else call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain) #endif From 2d2deae71b14696a98002b77e5774a7934b1c2dc Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 29 Jun 2020 23:39:41 +0000 Subject: [PATCH 057/217] updating sfc_diff.f to recompute z0 over ocean when coupled to ww3 and value is below 1.0e-7 --- ccpp/physics | 2 +- gfsphysics/physics/sfc_diff.f | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index e450d811b..37444dc7d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e450d811b464308e38838e317ee2a912b6490c9e +Subproject commit 37444dc7da2af9399c17c1c9bd63b100ea0fd81c diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index 77096794a..f150cdfc4 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -269,13 +269,13 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) z0rl(i,3) = 1.0d-4 endif - elseif (z0rl(i,3) <= 0.0d0) then + elseif (z0rl(i,3) < 1.0d-7) then z0 = (charnock / grav) * ustar(i,3) * ustar(i,3) if (redrag) then z0rl(i,3) = 100.0d0 * max(min(z0, z0s_max), 1.0d-7) else - z0rl(i,3) = 100.0d0 * max(min(z0, 0.1d0), 1.0d-70) + z0rl(i,3) = 100.0d0 * max(min(z0, 0.1d0), 1.0d-7) endif endif From b37e5f1f64c5f837b3c7759705775c602a45d95d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 30 Jun 2020 13:31:04 +0000 Subject: [PATCH 058/217] minor change in physics driver to turn on huge --- atmos_model.F90 | 3 --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 14 ++++---------- 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index ef62c3c5b..90c10a6be 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -339,7 +339,6 @@ subroutine update_atmos_radiation_physics (Atmos) call assign_importdata(rc) -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in atmos_model, after assign_importdata, rc=',rc endif call mpp_clock_end(setupClock) @@ -1659,8 +1658,6 @@ subroutine assign_importdata(rc) name=impfield_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',' n=',n,trim(impfield_name) - if ( dimCount == 2) then if ( datatype == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(importFields(n),farrayPtr=datar82d,localDE=0, rc=rc) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index e0a7461a6..fa7c7c82f 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -17,8 +17,7 @@ module module_physics_driver GFS_sfcprop_type, GFS_coupling_type, & GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type -! GFS_radtend_type, GFS_diag_type, huge + GFS_radtend_type, GFS_diag_type, huge use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_driver, & cloud_diagnosis use module_mp_thompson, only: mp_gt_driver @@ -60,7 +59,6 @@ module module_physics_driver real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys - real(kind=kind_phys), parameter :: huge = zero !> GFS Physics Implementation Layer !> @brief Layer that invokes individual GFS physics routines @@ -515,7 +513,6 @@ subroutine GFS_physics_driver & stress, t850, ep1d, gamt, gamq, sigmaf, & wind, work1, work2, work3, work4, runof, xmu, fm10, fh2, & tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,& -! dnsst, tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,& snowc, frland, adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, & adjnirdfd, adjvisbmd, adjvisdfd, xcosz, tseal, & @@ -811,8 +808,8 @@ subroutine GFS_physics_driver & ! lprnt = .false. ! do i=1,im -! lprnt = kdt >= 24 .and. abs(grid%xlon(i)*rad2dg-239.50) < 0.151 & -! .and. abs(grid%xlat(i)*rad2dg-75.05) < 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 & @@ -829,7 +826,7 @@ subroutine GFS_physics_driver & ! endif ! enddo ! if (lprnt) then -! if (MOdel%cplflx) then +! if (Model%cplflx) then ! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, & ! ' fice=',Sfcprop%fice(ipr),' ulw=',Coupling%ulwsfcin_cpl(ipr), & ! ' tsfc=',Sfcprop%tsfc(ipr) @@ -1711,10 +1708,7 @@ subroutine GFS_physics_driver & Sfcprop%z_c, wet, zero, omz1, im, 1, dtzm) do i=1,im if (wet(i) .and. Sfcprop%oceanfrac(i) > zero) then -! dnsst = tsfc3(i,3) - Sfcprop%tref(i) ! retrive/get difference of Ts and Tf Sfcprop%tref(i) = Sfcprop%tsfco(i) - dtzm(i) ! update Tf with T1 and NSST T-Profile -! tsfc3(i,3) = max(271.2,Sfcprop%tref(i) + dnsst ! get Ts updated due to Tf update -! tseal(i) = tsfc3(i,3) if (abs(Sfcprop%xz(i)) > zero) then tem2 = one / Sfcprop%xz(i) else From 20fbd4086ab6144eff1480f60430c180eb72862b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 8 Jul 2020 00:48:42 +0000 Subject: [PATCH 059/217] fixing errors/logic with fractional grid option to reproduce a continuous run from a restart run, both with IPD and CCPP physics --- atmos_model.F90 | 4 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 179 +++++++++++++++--- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 26 ++- gfsphysics/GFS_layer/GFS_typedefs.F90 | 3 + gfsphysics/GFS_layer/GFS_typedefs.meta | 11 +- gfsphysics/physics/dcyc2.f | 2 + gfsphysics/physics/gcycle.F90 | 10 +- gfsphysics/physics/radiation_surface.f | 4 +- gfsphysics/physics/sfc_diff.f | 2 - io/FV3GFS_io.F90 | 84 +++++--- 10 files changed, 261 insertions(+), 64 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 90c10a6be..c371460fc 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1776,8 +1776,8 @@ subroutine assign_importdata(rc) IPD_Data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then if (IPD_Data(nb)%Sfcprop%fice(ix) > one-epsln) IPD_Data(nb)%Sfcprop%fice(ix) = one -! if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points - IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys + if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys !slmsk=2 crashes in gcycle on partial land points +! IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys else IPD_Data(nb)%Sfcprop%fice(ix) = zero diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index fa7c7c82f..7e2114c75 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -17,6 +17,7 @@ module module_physics_driver GFS_sfcprop_type, GFS_coupling_type, & GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & +! GFS_radtend_type, GFS_diag_type GFS_radtend_type, GFS_diag_type, huge use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_driver, & cloud_diagnosis @@ -59,6 +60,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys +! real(kind=kind_phys), parameter :: huge = 0.0_kind_phys !> GFS Physics Implementation Layer !> @brief Layer that invokes individual GFS physics routines @@ -808,8 +810,16 @@ subroutine GFS_physics_driver & ! lprnt = .false. ! do i=1,im -! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-97.50) < 0.101 & -! .and. abs(grid%xlat(i)*rad2dg-24.48) < 0.101 +! lprnt = Model%me == 23 .and. i == 25 +! lprnt = Model%me == 127 .and. i == 11 +! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-102.65) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-0.12) < 0.201 +! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 & +! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301 +! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-81.23) < 0.101 +! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-28.800) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg+2.45) < 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 & @@ -832,8 +842,13 @@ subroutine GFS_physics_driver & ! ' tsfc=',Sfcprop%tsfc(ipr) ! else ! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, & -! ' fice=',Sfcprop%fice(ipr), ' tsfc=',Sfcprop%tsfc(ipr) +! ' fice=',Sfcprop%fice(ipr), ' tsfc=',Sfcprop%tsfc(ipr), & +! 'tsfcl=',Sfcprop%tsfcl(ipr),' tsfco=',Sfcprop%tsfco(ipr) ! endif +! if (Model%nstf_name(1) > 0) then +! write(0,*)' begin sfcprop%tref=',Sfcprop%tref(ipr),' kdt=',kdt, & +! ' landfrac=',Sfcprop%landfrac(ipr) +! endif ! endif !------------------------------------------------------------------------------------------- ! @@ -841,8 +856,9 @@ subroutine GFS_physics_driver & ! write(0,*)' in phydrv tgrs=',Statein%tgrs(ipr,:) ! write(0,*)' in phydrv ugrs=',Statein%ugrs(ipr,:) ! write(0,*)' in phydrv vgrs=',Statein%vgrs(ipr,:) -! write(0,*)' in phydrv qgrs=',Statein%qgrs(ipr,:,1) +! write(0,*)' in phydrv qgrs=',Statein%qgrs(ipr,:,1)*1000.0 ! write(0,*)' in phydrv tke=',Statein%qgrs(ipr,:,ntke) +! write(0,*)' in phydrv phii=',Statein%phii(ipr,:) ! endif ! ! --- ... frain=factor for centered difference scheme correction of rain amount. @@ -1016,15 +1032,20 @@ subroutine GFS_physics_driver & Statein%prsl, Statein%prslk, Statein%phii, Statein%phil, del) #else !GFDL Adjust the geopotential height hydrostatically in a way consistent with FV3 discretization +! if (lprnt) write(0,*)'bef get_prs_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt + call get_prs_fv3 (ix, levs, ntrac, Statein%phii, Statein%prsi, & Statein%tgrs, Statein%qgrs, del, del_gz) #endif +! if (lprnt) write(0,*)'aft get_prs_fv3 phii=',Statein%phii(ipr,:) +! if (lprnt) write(0,*)'aft get_prs_fv3 del_gz=',del_gz(ipr,:) !*## CCPP ## !## CCPP ##* GFS_surface_generic.F90/GFS_surface_generic_pre_run do i = 1, IM sigmaf(i) = max( Sfcprop%vfrac(i),0.01_kind_phys ) islmsk(i) = nint(Sfcprop%slmsk(i)) + islmsk_cice(i) = islmsk(i) if (islmsk(i) == 2) then if (Model%isot == 1) then @@ -1107,24 +1128,31 @@ subroutine GFS_physics_driver & if (flag_cice(i)) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. + if (fice(i) < one) wet(i) = .true. ! some open ocean/lake water exists else fice(i) = zero flag_cice(i) = .false. islmsk_cice(i) = 0 - islmsk(i) = 0 +! islmsk(i) = 0 + wet(i) = .true. ! some open ocean/lake water exists endif else if (fice(i) >= Model%min_lakeice) then icy(i) = .true. + if (fice(i) < one) wet(i) = .true. ! some open ocean/lake water exists + islmsk(i) = 2 else fice(i) = zero - islmsk(i) = 0 +! islmsk(i) = 0 + wet(i) = .true. ! some open ocean/lake water exists endif endif - if (fice(i) < one) then - wet(i) = .true. ! some open ocean/lake water exists - if ((.not. Model%cplflx .or. Sfcprop%oceanfrac(i) == zero) .and. icy(i)) & + if (wet(i) .and. .not. Model%cplflx) then + if (Sfcprop%oceanfrac(i) > zero) then + Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) + elseif (icy(i)) then Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif endif else fice(i) = zero @@ -1209,6 +1237,8 @@ subroutine GFS_physics_driver & enddo endif endif +! if (lprnt) write(0,*)' dry=',dry(ipr),' wet=',wet(ipr),' icy=',icy(ipr) ,& +! ' tsfco=',Sfcprop%tsfco(ipr) do i=1,im if(wet(i)) then ! Water zorl3(i,3) = Sfcprop%zorlo(i) @@ -1234,7 +1264,7 @@ subroutine GFS_physics_driver & if (icy(i)) then ! Ice uustar3(i,2) = Sfcprop%uustar(i) weasd3(i,2) = Sfcprop%weasd(i) - zorl3(i,2) = Sfcprop%zorll(i) + zorl3(i,2) = Sfcprop%zorli(i) tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) snowd3(i,2) = Sfcprop%snowd(i) @@ -1542,7 +1572,7 @@ subroutine GFS_physics_driver & enddo endif ! if (lprnt) write(0,*)' kdt=',kdt,' tsfc=',Sfcprop%tsfc(ipr),' adjsfculw=',adjsfculw(ipr),& -! ' adjsfculw3=',adjsfculw3(ipr,:),' icefr=',Sfcprop%fice(ipr),' tsfc3=',tsfc3(ipr,:) +! ' adjsfculw3=',adjsfculw3(ipr,:),' icefr=',fice(ipr),' tsfc3=',tsfc3(ipr,:) ! do i=1,im Diag%dlwsfc(i) = Diag%dlwsfc(i) + adjsfcdlw(i)*dtf @@ -1663,8 +1693,9 @@ subroutine GFS_physics_driver & ! --- ... surface exchange coefficients ! -! if (lprnt) write(0,*)' tsfc=',Sfcprop%tsfc(ipr),' tsurf=',tsurf(ipr),'iter=', & -! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr) +! if (lprnt) write(0,*)' tsfc=',Sfcprop%tsfc(ipr),'iter=', & +! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& +! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:) !## CCPP ##* sfc_diff.f/sfc_diff_run call sfc_diff & @@ -1683,6 +1714,8 @@ subroutine GFS_physics_driver & cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23) ! cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23, wind, lprnt, ipr) ! +! if (lprnt) write(0,*)' aft sfc_diff cd3=',cd3(ipr,:),' cdq3=',cdq3(ipr,:),'iter=', iter, & +! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:) ! --- ... lu: update flag_guess !*## CCPP ## !## CCPP ##* GFS_surface_loop_control/GFS_surface_loop_control_part1_run @@ -1722,7 +1755,12 @@ subroutine GFS_physics_driver & endif ! if (lprnt) write(0,*)' bef nst tseal=',tseal(ipr) & -! ,' tsfc3=',tsfc3(ipr,3),' tsurf3=',tsurf3(ipr,3),' tem=',tem +! ,' tsfc3=',tsfc3(ipr,3),' tsurf3=',tsurf3(ipr,3), & +! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& +! ' tref=',Sfcprop%tref(ipr),' tgrs=',Statein%tgrs(ipr,1),' qgrs=',Statein%qgrs(ipr,1,1), & +! ' prsl=',Statein%prsl(ipr,1),' cd3=',cd3(ipr,3),' cdq3=',cdq3(ipr,3),' work3=', & +! work3(ipr),' semis3=',semis3(ipr,3),' gabsbdlw3=',gabsbdlw3(ipr,3),' adjsfcnsw=', & +! adjsfcnsw(ipr),' wind=',wind(ipr),' tseal=',tseal(ipr),' xcosz=',xcosz(ipr) !*## CCPP ## !## CCPP ##* sfc_nst.f/sfc_nst_run call sfc_nst & @@ -1774,6 +1812,9 @@ subroutine GFS_physics_driver & endif enddo endif + +! if (lprnt) write(0,*)' aft nst tref=',Sfcprop%tref(ipr) & +! ,' tsfc3=',tsfc3(ipr,3),' dtzm=',dtzm(ipr),' hflx33=',hflx3(ipr,3) !*## CCPP ## ! if (lprnt) print *,' tseaz2=',Sfcprop%tsfc(ipr),' tref=',tref(ipr), & ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt @@ -1836,10 +1877,10 @@ subroutine GFS_physics_driver & snohf, Diag%smcwlt2, Diag%smcref2, Diag%wet1) !*## CCPP ## -! if (lprnt) write(0,*)' tseae=',tseal(ipr),' tsurf=',tsurf(ipr),iter& +! if (lprnt) write(0,*)' tseae=',tseal(ipr),' tsurf=',tsurf(ipr),iter ! ,' phy_f2d=',phy_f2d(ipr,num_p2d) -! if (lprnt) write(0,*)' hflx3=',hflx3(ipr,:),' evap3=',evap3(i,:) +! if (lprnt) write(0,*)' hflx3=',hflx3(ipr,:),' evap3=',evap3(ipr,:) !## CCPP ##* sfc_noahmp_drv.f/noahmpdrv_run ! Noah MP call @@ -1920,14 +1961,14 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' tseabeficemodel =',Sfcprop%tsfc(ipr),' me=',me & ! &, ' kdt=',kdt,' tsfc32=',tsfc3(ipr,2),' fice=',fice(ipr) & -! &,' stsoil=',stsoil(ipr,:) +! &,' stsoil=',stsoil(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) ! --- ... surface energy balance over seaice !## CCPP ##* sfc_sice.f/sfc_sice_run (local adjustment to avoid resetting islmsk after call to sfc_sice_run) if (Model%cplflx) then do i=1,im if (flag_cice(i)) then - islmsk (i) = islmsk_cice(i) + islmsk(i) = islmsk_cice(i) endif enddo !*## CCPP ## @@ -1953,15 +1994,30 @@ subroutine GFS_physics_driver & ! ! call sfc_sice for lake ice and for the uncoupled case, sea ice (i.e. islmsk=2) ! + if (Model%frac_grid) then + do i=1,im + if (icy(i) .and. islmsk(i) < 2) then + if (Sfcprop%oceanfrac(i) > zero) then + tem = Model%min_seaice + else + tem = Model%min_lakeice + endif + if (fice(i) > tem) then + islmsk(i) = 2 + tsfc3(i,2) = Sfcprop%tisfc(i) + endif + endif + enddo + endif !## CCPP ##* sfc_sice.f/sfc_sice_run call sfc_sice & ! --- inputs: - (im, lsoil, Statein%pgr, & + (im, lsoil, Statein%pgr, & Statein%tgrs(:,1), Statein%qgrs(:,1,1), dtf, semis3(:,2), & ! Statein%tgrs(:,1), Statein%qgrs(:,1,1), dtf, Radtend%semis, & gabsbdlw3(:,2), adjsfcnsw, adjsfcdsw, Sfcprop%srflag, & cd3(:,2), cdq3(:,2), & - Statein%prsl(:,1), work3, islmsk, wind, & + Statein%prsl(:,1), work3, islmsk, wind, & flag_iter, lprnt, ipr, Model%min_lakeice, & ! --- input/output: zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & @@ -1971,6 +2027,14 @@ subroutine GFS_physics_driver & evap3(:,2), hflx3(:,2)) !*## CCPP ## !## CCPP ##* This section is not needed for CCPP. + if (Model%frac_grid) then + do i = 1, im + if (islmsk(i) == 2 .and. fice(i) < one) then + wet(i) = .true. + tsfc3(i,3) = max(Sfcprop%tisfc(i), tgice) + endif + enddo + endif if (Model%cplflx) then do i = 1, im if (flag_cice(i)) then @@ -1980,8 +2044,9 @@ subroutine GFS_physics_driver & endif !*## CCPP ## -! if (lprnt) write(0,*)' tseaafticemodel =',tsfc3(ipr,2),' me=',me & -! &, ' kdt=',kdt,' iter=',iter,' fice=',fice(ipr) +! if (lprnt) write(0,*)' tseaafticemodel =',tsfc3(ipr,:),' me=',me & +! &, ' kdt=',kdt,' iter=',iter,' fice=',fice(ipr),' wet=',wet(ipr),' icy=',icy(ipr)& +! &,' dry=',dry(ipr) ! --- ... lu: update flag_iter and flag_guess !## CCPP ##* GFS_surface_loop_control.F90/GFS_surface_loop_control_part_2 @@ -2012,6 +2077,11 @@ subroutine GFS_physics_driver & txl = frland(i) txi = fice(i)*(one - frland(i)) ! txi = ice fraction wrt whole cell txo = max(zero, one - txl - txi) + +! if (i == ipr .and. lprnt) write(0,*)' txl=',txl,' fice=',fice(i),' txi=',txi,& +! ' txo=',txo,' dry=',dry(i),' wet=',wet(i),' icy=',icy(i),' oceanfrac=',& +! Sfcprop%oceanfrac(i),' frland=',frland(i) + Sfcprop%zorl(i) = txl*zorl3(i,1) + txi*zorl3(i,2) + txo*zorl3(i,3) cd(i) = txl*cd3(i,1) + txi*cd3(i,2) + txo*cd3(i,3) cdq(i) = txl*cdq3(i,1) + txi*cdq3(i,2) + txo*cdq3(i,3) @@ -2049,14 +2119,41 @@ 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) +! if (i == ipr .and. lprnt) then +! write(0,*)' tsfc=',Sfcprop%tsfc(i),' txl=',txl,' txi=',txi,' txo=',txo, & +! ' tsfc3=',tsfc3(i,:),' evap3=',evap3(i,:),' evap=',evap(i),' tice=',tice(i),& +! 'Sfcprop%zorl=',Sfcprop%zorl(ipr) +! endif + ! 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%zorli(i) = zorl3(i,2) Sfcprop%zorlo(i) = zorl3(i,3) - if (dry(i)) Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land - if (wet(i)) Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake or ocean when uncoupled + if (dry(i)) then + Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land + elseif (wet(i)) then + Sfcprop%tsfcl(i) = tsfc3(i,3) ! over land + else + Sfcprop%tsfcl(i) = tice(i) ! over land + endif + if (wet(i)) then + Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake or ocean when uncoupled + elseif (icy(i)) then + Sfcprop%tsfco(i) = tice(i) ! over lake or ocean when uncoupled + else + Sfcprop%tsfco(i) = tsfc3(i,1) ! over lake or ocean when uncoupled + endif + if (icy(i)) then + Sfcprop%tisfc(i) = tice(i) ! over lake or ocean when uncoupled +! if (Sfcprop%zorll(i) > 1000.0) Sfcprop%zorll(i) = zorl3(i,2) + elseif (wet(i)) then + Sfcprop%tisfc(i) = tsfc3(i,3) ! over lake or ocean when uncoupled + else + Sfcprop%tisfc(i) = tsfc3(i,1) ! over lake or ocean when uncoupled + endif ! for coupled model ocean will replace this ! if (icy(i)) Sfcprop%tisfc(i) = tsfc3(i,2) ! over ice when uncoupled ! if (icy(i)) Sfcprop%tisfc(i) = tice(i) ! over ice when uncoupled @@ -2067,7 +2164,8 @@ subroutine GFS_physics_driver & ! endif if (.not. flag_cice(i)) then - if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array +! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + if (icy(i)) then ! return updated lake ice thickness & concentration to global array Sfcprop%hice(i) = zice(i) Sfcprop%fice(i) = fice(i) Sfcprop%tisfc(i) = tice(i) @@ -2080,6 +2178,10 @@ subroutine GFS_physics_driver & enddo else do i=1,im + if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then + islmsk(i) = 0 + fice(i) = zero + endif if (islmsk(i) == 1) then k = 1 Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land @@ -2121,6 +2223,7 @@ subroutine GFS_physics_driver & Sfcprop%tsfc(i) = tsfc3(i,k) Sfcprop%zorll(i) = zorl3(i,1) + Sfcprop%zorli(i) = zorl3(i,2) Sfcprop%zorlo(i) = zorl3(i,3) if (flag_cice(i)) then @@ -2150,6 +2253,9 @@ subroutine GFS_physics_driver & else Sfcprop%tsfco(i) =Sfcprop%tsfc(i) endif + do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case + Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) + enddo enddo endif ! if (Model%frac_grid) !*## CCPP ## @@ -2355,6 +2461,7 @@ subroutine GFS_physics_driver & ! enddo ! write(0,*)' before monin clstp=',clstp,' kdt=',kdt,' lat=',lat +! if (lprnt) write(0,*)'befmonshoc phii=',Statein%phii(ipr,:) ! if (lprnt) write(0,*)'befmonshoc=',Statein%tgrs(ipr,:) ! if (lprnt) write(0,*)'befmonshocdtdt=',dtdt(ipr,1:10) ! if (lprnt) write(0,*)'befmonshoctkh=',Tbd%phy_f3d(ipr,1:10,ntot3d-1) @@ -2387,8 +2494,9 @@ subroutine GFS_physics_driver & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) ! if (lprnt) then +! write(0,*)' aftpbl phii=',Statein%phii(ipr,:) ! write(0,*)' aftpbl dtdt=',dtdt(ipr,:) -! write(0,*)' aftpbl dqdtv=',dqdt(ipr,:,1) +! 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) @@ -2396,6 +2504,7 @@ subroutine GFS_physics_driver & ! 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) @@ -3376,9 +3485,15 @@ subroutine GFS_physics_driver & Model%gen_coord_hybrid Statein%prsi, Statein%prsik, & Statein%prsl, Statein%prslk, Statein%phii, Statein%phil) #else +! if (lprnt) write(0,*)'bef get_phi_fv3 gt0=',Stateout%gt0(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)'bef get_phi_fv3 gq0=',Stateout%gq0(ipr,:,1),' kdt=',kdt +! if (lprnt) write(0,*)'bef get_phi_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt + !GFDL Adjust the height hydrostatically in a way consistent with FV3 discretization call get_phi_fv3 (ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & del_gz, Statein%phii, Statein%phil) + +! if (lprnt) write(0,*)'aft get_phi_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt #endif !*## CCPP ## @@ -3621,6 +3736,7 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)'gt01=',Stateout%gt0(ipr,:) ! if (lprnt) write(0,*)'gq01=',Stateout%gq0(ipr,:,1) +! if (lprnt) write(0,*)'phii=',Statein%phii(ipr,:),' kdt=',kdt ! if (lprnt) write(0,*)'clwi=',clw(ipr,:,1) ! if (lprnt) write(0,*)'clwl=',clw(ipr,:,2) ! if (lprnt) write(0,*)'befncpi=',ncpi(ipr,:) @@ -5578,6 +5694,7 @@ subroutine GFS_physics_driver & ! write(0,*) ' endgt0=',Stateout%gt0(ipr,:),' kdt=',kdt ! write(0,*) ' endgq0=',Stateout%gq0(ipr,:,1),' kdt=',kdt ! write(0,*) ' endgw0=',gq0(ipr,:,3),' kdt=',kdt,' lat=',lat +! write(0,*) ' endzorl=',Sfcprop%zorl(ipr),' kdt=',kdt ! endif if (Model%do_sppt .or. Model%ca_global)then @@ -5678,6 +5795,16 @@ subroutine GFS_physics_driver & enddo !*## CCPP ## ! if (kdt > 2 ) stop + +! if (Model%nstf_name(1) > 0) then +! if (lprnt) write(0,*)' end driver sfcprop%tref=',Sfcprop%tref(ipr),' kdt=',kdt +! endif +! if (Model%frac_grid) then +! if (lprnt) write(0,*)' end driver sfcprop%tsfcl=',Sfcprop%tsfcl(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tsfco=',Sfcprop%tsfco(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt +! endif + return !................................... end subroutine GFS_physics_driver diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index a029063ff..0a551ef19 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -319,7 +319,7 @@ module module_radiation_driver ! & epsm1 => con_epsm1, & & fvirt => con_fvirt & &, rog => con_rog & - &, rocp => con_rocp + &, rocp => con_rocp, pi => con_pi use funcphys, only: fpvs use module_radiation_astronomy,only: sol_init, sol_update, coszmn @@ -1230,6 +1230,9 @@ subroutine GFS_radiation_driver & !--- TYPED VARIABLES type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw + real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/pi +! logical :: lprnt +! integer :: ipt ! logical effr_in ! data effr_in/.false./ ! @@ -1295,6 +1298,25 @@ subroutine GFS_radiation_driver & raddt = min(Model%fhswr, Model%fhlwr) ! print *,' in grrad : raddt=',raddt + +! lprnt = .false. + +! do i=1,im +! lprnt = Model%kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-102.65) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-0.12) < 0.201 +! lprnt = Model%kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 & +! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301 +! if (kdt == 1) & +! write(2000+me,*)' i=',i,' xlon=',grid%xlon(i)*rad2dg, +! & +! ' xlat=',grid%xlat(i)*rad2dg,' me=',me +! if (lprnt) then +! ipt = i +! write(0,*)' ipt=',ipt,'xlon=',grid%xlon(i)*rad2dg,' xlat=',grid%xlat(i)*rad2dg,' me=',me +! exit +! endif +! enddo + !> -# Setup surface ground temperature and ground/air skin temperature !! if required. @@ -1857,7 +1879,7 @@ subroutine GFS_radiation_driver & !> - Call module_radsw_main::swrad(), to compute SW heating rates and !! fluxes. ! print *,' in grrad : calling swrad' - + if (Model%swhtr) then call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 5da588a48..8f577463e 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -241,6 +241,7 @@ module GFS_typedefs 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 :: zorli (:) => null() !< ice 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 @@ -2177,6 +2178,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%zorl (IM)) allocate (Sfcprop%zorlo (IM)) allocate (Sfcprop%zorll (IM)) + allocate (Sfcprop%zorli (IM)) allocate (Sfcprop%fice (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) @@ -2194,6 +2196,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%zorl = clear_val Sfcprop%zorlo = clear_val Sfcprop%zorll = clear_val + Sfcprop%zorli = clear_val Sfcprop%fice = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index 925e96397..67c2da461 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -527,6 +527,13 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys [fice] standard_name = sea_ice_concentration long_name = ice fraction over open water @@ -3397,14 +3404,14 @@ [min_lakeice] standard_name = lake_ice_minimum long_name = minimum lake ice value - units = ??? + units = frac dimensions = () type = real kind = kind_phys [min_seaice] standard_name = sea_ice_minimum long_name = minimum sea ice value - units = ??? + units = frac dimensions = () type = real kind = kind_phys diff --git a/gfsphysics/physics/dcyc2.f b/gfsphysics/physics/dcyc2.f index a97b428b5..196148d2b 100644 --- a/gfsphysics/physics/dcyc2.f +++ b/gfsphysics/physics/dcyc2.f @@ -276,6 +276,8 @@ subroutine dcyc2t3 & else xmu(i) = 0.0 endif +! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: sfcnsw=',sfcnsw(i) +! &,' sfcdsw=',sfcdsw(i),' xmu=',xmu(i) ! --- ... adjust sfc net and downward sw fluxes for zenith angle changes ! note: sfc emiss effect will not be appied here diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index f7dae4881..8e799fb12 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -60,7 +60,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, dt_warm - integer :: npts, len, nb, ix, jx, ls, ios + integer :: npts, len, nb, ix, jx, ls, ios, ll logical :: exists ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@ -237,9 +237,11 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%alnsf (ix) = ALBFC1 (len + npts*2) Sfcprop(nb)%alnwf (ix) = ALBFC1 (len + npts*3) do ls = 1,Model%lsoil - Sfcprop(nb)%smc (ix,ls) = SMCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%stc (ix,ls) = STCFC1 (len + (ls-1)*npts) - Sfcprop(nb)%slc (ix,ls) = SLCFC1 (len + (ls-1)*npts) + ll = len + (ls-1)*npts + Sfcprop(nb)%smc (ix,ls) = SMCFC1 (ll) + Sfcprop(nb)%stc (ix,ls) = STCFC1 (ll) + Sfcprop(nb)%slc (ix,ls) = SLCFC1 (ll) + if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (ll) enddo ENDDO !-----END BLOCK SIZE LOOP------------------------------ ENDDO !-----END BLOCK LOOP------------------------------- diff --git a/gfsphysics/physics/radiation_surface.f b/gfsphysics/physics/radiation_surface.f index e02ea32b9..99f0ebc2f 100644 --- a/gfsphysics/physics/radiation_surface.f +++ b/gfsphysics/physics/radiation_surface.f @@ -609,7 +609,7 @@ subroutine setalb & ab1bm = min(0.99, alnsf(i)*rfcs) ab2bm = min(0.99, alvsf(i)*rfcs) sfcalb(i,1) = ab1bm *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = alnwf(i) *flnd + asend*fsea + asnnd*fsno + sfcalb(i,2) = alnwf(i)*flnd + asend*fsea + asnnd*fsno sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno sfcalb(i,4) = alvwf(i) *flnd + asevd*fsea + asnvd*fsno @@ -620,7 +620,7 @@ subroutine setalb & ! sfc-perts, mgehne *** ! perturb all 4 kinds of surface albedo, sfcalb(:,1:4) - if (pertalb(1)>0.0) then + if (pertalb(1) > 0.0) then do i = 1, imax do kk=1, 4 ! compute beta distribution parameters for all 4 albedos diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index f150cdfc4..c807595c5 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -23,7 +23,6 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) ! -------- -------- --------- integer, intent(in) :: im, ivegsrc integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean - integer, dimension(im), intent(in) :: vegtype logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) @@ -187,7 +186,6 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) ztmax = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar(i,2)*(0.01/1.5e-05))) ztmax = max(ztmax, 1.0e-6) ->>>>>>> upstream/develop ! call stability ! --- inputs: diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 918ebb457..7e8ebccba 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -504,7 +504,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !--- local variables for sncovr calculation integer :: vegtyp logical :: mand - real(kind=kind_phys) :: rsnow, tem + real(kind=kind_phys) :: rsnow, tem, tem1 !--- Noah MP integer :: soiltyp,ns,imon,iter,imn real(kind=kind_phys) :: masslai, masssai,snd @@ -633,7 +633,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo - if (Model%cplflx .or. Model%frac_grid) then ! needs more variables + if (Model%frac_grid) then ! needs more variables + nvar_s2m = 35 + elseif (Model%cplflx) then ! needs more variables nvar_s2m = 34 else nvar_s2m = 32 @@ -661,6 +663,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp)) + allocate(sfc_var3ice(nx,ny,Model%kice)) allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) #endif sfc_var2 = -9999.0_r8 @@ -710,9 +713,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) sfc_name2(31) = 'snoalb' !--- variables below here are optional sfc_name2(32) = 'sncovr' - if(Model%cplflx) then + if(Model%cplflx .or. Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell + sfc_name2(35) = 'zorli' !zorl on land portion of a cell end if !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) @@ -786,7 +790,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll') then + if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' .or. trim(sfc_name2(num)) == 'zorli') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -901,6 +905,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) call mpp_error(NOTE,'reading surface properties data from INPUT/sfc_data.tile*.nc') call restore_state(Sfc_restart) +! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,35)),maxval(sfc_var2(:,:,35)),' sfc_name2=',sfc_name2(35) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,18)),maxval(sfc_var2(:,:,18)) ! write(0,*)' sfc_var2=',sfc_var2(:,:,12) @@ -949,17 +954,18 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if(Model%cplflx .or. Model%frac_grid) then Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) - end if + Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) + endif if(Model%frac_grid) then ! obtain slmsk from landfrac !! next 5 lines are temporary till lake model is available if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) +! Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) if (Sfcprop(nb)%lakefrac(ix) == zero) Sfcprop(nb)%fice(ix) = zero - end if + endif Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%fice(ix) > zero .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist else ! obtain landfrac from slmsk if (Sfcprop(nb)%slmsk(ix) > 1.9_r8) then Sfcprop(nb)%landfrac(ix) = zero @@ -970,10 +976,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) Sfcprop(nb)%fice(ix) = zero + if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then + Sfcprop(nb)%fice(ix) = zero + if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 + endif else Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (Sfcprop(nb)%fice(ix) < Model%min_seaice) Sfcprop(nb)%fice(ix) = zero + if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then + Sfcprop(nb)%fice(ix) = zero + if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 + endif endif ! !--- NSSTM variables @@ -1204,9 +1216,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif + + if (sfc_var2(i,j,35) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') +!$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) !--- compute zorli from existing variables + enddo + enddo + endif + endif -#ifdef CCPP +!#ifdef CCPP if (nint(sfc_var3ice(1,1,1)) == -9999) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') do nb = 1, Atm_block%nblks @@ -1217,30 +1240,33 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo endif -#endif +!#endif !#endif if(Model%frac_grid) then ! 3-way composite -!$omp parallel do default(shared) private(nb, ix, tem) +!$omp parallel do default(shared) private(nb, ix, tem, tem1) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) - tem = (one-Sfcprop(nb)%landfrac(ix)) * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell + tem1 = one - Sfcprop(nb)%landfrac(ix) + tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%zorll(ix) * tem & !zorl ice = zorl land - + Sfcprop(nb)%zorlo(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) + + Sfcprop(nb)%zorli(ix) * tem & + + Sfcprop(nb)%zorlo(ix) * (tem1-tem) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & + Sfcprop(nb)%tisfc(ix) * tem & - + Sfcprop(nb)%tsfco(ix) * (one-Sfcprop(nb)%landfrac(ix)-tem) + + Sfcprop(nb)%tsfco(ix) * (tem1-tem) enddo enddo else !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - !--- specify tsfcl/zorll from existing variable tsfco/zorlo + !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) + Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) enddo @@ -1548,7 +1574,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() - if (Model%cplflx) then ! needs more variables + if (Model%frac_grid) then ! needs more variables + nvar2m = 35 + elseif (Model%cplflx) then ! needs more variables nvar2m = 34 else nvar2m = 32 @@ -1669,6 +1697,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (Model%cplflx) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell + sfc_name2(35) = 'zorli' !zorl on land portion of a cell end if !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) sfc_name2(nvar2m+1) = 'tref' @@ -1739,7 +1768,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll') then + if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' .or.trim(sfc_name2(num)) == 'zorli') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -1811,7 +1840,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name3(0) = 'tiice' var3_p => sfc_var3ice(:,:,:) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain) - end if + endif do num = 1,nvar3 var3_p => sfc_var3(:,:,:,num) @@ -1846,10 +1875,16 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 sfc_var2(i,j,1) = Sfcprop(nb)%slmsk(ix) !--- slmsk - sfc_var2(i,j,2) = Sfcprop(nb)%tsfc(ix) !--- tsfc (tsea in sfc file) + if (Model%frac_grid) then + sfc_var2(i,j,2) = Sfcprop(nb)%tsfco(ix) !--- tsfc (tsea in sfc file) + sfc_var2(i,j,5) = Sfcprop(nb)%zorlo(ix) !--- zorlo + else + sfc_var2(i,j,2) = Sfcprop(nb)%tsfc(ix) !--- tsfc (tsea in sfc file) + sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl + endif sfc_var2(i,j,3) = Sfcprop(nb)%weasd(ix) !--- weasd (sheleg in sfc file) sfc_var2(i,j,4) = Sfcprop(nb)%tg3(ix) !--- tg3 - sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl +! sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl sfc_var2(i,j,6) = Sfcprop(nb)%alvsf(ix) !--- alvsf sfc_var2(i,j,7) = Sfcprop(nb)%alvwf(ix) !--- alvwf sfc_var2(i,j,8) = Sfcprop(nb)%alnsf(ix) !--- alnsf @@ -1877,9 +1912,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,30) = Sfcprop(nb)%slope(ix) !--- slope sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix)!--- sncovr - if (Model%cplflx) then + if (Model%cplflx .or. Model%frac_grid) then sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) + sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) end if !--- NSSTM variables if (Model%nstf_name(1) > 0) then From acd71f4d0aecffaafa3eeaff02dcb6e547afc804 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 10 Jul 2020 00:10:12 +0000 Subject: [PATCH 060/217] after submodule sync --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 37444dc7d..3af3d7f9b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 37444dc7da2af9399c17c1c9bd63b100ea0fd81c +Subproject commit 3af3d7f9b1ae847662958ffbebba28e79ef23bf4 From 39cb436ea1fb6f518086202b6f9bedfc1836f3f4 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 20 Jul 2020 19:03:45 +0000 Subject: [PATCH 061/217] change in gitmodules and some fixes in physics --- .gitmodules | 8 ++++---- atmos_model.F90 | 4 ++-- ccpp/framework | 2 +- ccpp/physics | 2 +- fv3_cap.F90 | 2 +- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 5 +++++ 6 files changed, 14 insertions(+), 9 deletions(-) diff --git a/.gitmodules b/.gitmodules index 0fbad50f5..b6fab7da5 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,11 +1,11 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere - branch = dev/emc + url = https://github.com/NOAA-EMC/SMoorthi-emc/GFDL_atmos_cubed_sphere + branch = SM_Jul092020 [submodule "ccpp/framework"] path = ccpp/framework - url = https://github.com/NCAR/ccpp-framework - branch = master + url = https://github.com/SMoorthi-emc/ccpp-framework + branch = SM_Jul092020 [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics diff --git a/atmos_model.F90 b/atmos_model.F90 index 5668a42bc..ddb54eac9 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1761,7 +1761,7 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then + if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then ! IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j) IPD_Data(nb)%Sfcprop%tisfc(ix) = datar8(i,j) endif @@ -1781,7 +1781,7 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then + if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then ! IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) IPD_Data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) endif diff --git a/ccpp/framework b/ccpp/framework index b14e3e041..209f1c92d 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit b14e3e0415205ea4d3004bfb5241cc34da702db8 +Subproject commit 209f1c92d99b7d4cc63e0d41c652fcfd730bd9fa diff --git a/ccpp/physics b/ccpp/physics index f967360f2..21f7fddfd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f967360f234c77390a6e1e47d077d7b8eabd3352 +Subproject commit 21f7fddfd1885896a2ac282c093c9529b10e1bd6 diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 95786b17a..d0d55b47a 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -203,7 +203,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") - call ESMF_AttributeGet(gcomp, name="DumpFields_ATM", value=value, defaultValue="false", & + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index 0a551ef19..ebec30c4d 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -1382,6 +1382,11 @@ subroutine GFS_radiation_driver & plyr(i,k1) = 0.5d0 * (plvl(i,k1+1) + plvl(i,k1)) prslk1(i,k1) = (plyr(i,k1)*0.001d0) ** rocp enddo + else + k1 = lm + kd + do i = 1, IM + plvl(i,k1+1) = 0.01d0 * Statein%prsi(i,Model%levs+1) ! pa to mb (hpa) + enddo endif endif ! From 9ed3e5247c47ee465246284835b91e206c78908e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 20 Jul 2020 20:01:11 +0000 Subject: [PATCH 062/217] after syncing .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index b6fab7da5..1ca0f5396 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/SMoorthi-emc/GFDL_atmos_cubed_sphere + url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere branch = SM_Jul092020 [submodule "ccpp/framework"] path = ccpp/framework From a4a306e06200f2af1d6bfbae88ea53592d78388f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 21 Jul 2020 19:46:26 +0000 Subject: [PATCH 063/217] after merging with fv3/develop with flake and adding a z0 update for wave/atm coupling --- .gitmodules | 2 +- atmos_model.F90 | 11 ++++++----- ccpp/physics | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/.gitmodules b/.gitmodules index 1ca0f5396..e2f4dc77a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jul092020 + branch = SM_Jul202020 diff --git a/atmos_model.F90 b/atmos_model.F90 index ddb54eac9..d32609c48 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -222,9 +222,10 @@ module atmos_model_mod logical,parameter :: flip_vc = .true. #endif - real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, & - one = 1.0_IPD_kind_phys, & - epsln = 1.0e-10_IPD_kind_phys + real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, & + one = 1.0_IPD_kind_phys, & + epsln = 1.0e-10_IPD_kind_phys, & + zorlmin = 1.0e-7_IPD_kind_phys contains @@ -1739,8 +1740,8 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then - tem = 100.0_IPD_kind_phys * max(zero, min(0.1_IPD_kind_phys, datar8(i,j))) + if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > zorlmin) then + tem = 100.0_IPD_kind_phys * min(0.1_IPD_kind_phys, datar8(i,j)) ! IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem IPD_Data(nb)%Sfcprop%zorlo(ix) = tem diff --git a/ccpp/physics b/ccpp/physics index 21f7fddfd..20336bff8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 21f7fddfd1885896a2ac282c093c9529b10e1bd6 +Subproject commit 20336bff8cf85d5e8026ca1e4513fb2cd049d3cb From 340680232ba7bb945d8cdadb95fcb820c205f356 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Jul 2020 11:11:11 +0000 Subject: [PATCH 064/217] updating fix for wave coupling issue and some other fixes related to fractional grid --- atmos_model.F90 | 3 ++ ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 3 ++ gfsphysics/GFS_layer/GFS_typedefs.meta | 7 +++ gfsphysics/physics/sfc_diff.f | 7 +-- io/FV3GFS_io.F90 | 52 ++++++++++++++++++--- 7 files changed, 64 insertions(+), 12 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index d32609c48..0b16ae69f 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1744,6 +1744,9 @@ subroutine assign_importdata(rc) tem = 100.0_IPD_kind_phys * min(0.1_IPD_kind_phys, datar8(i,j)) ! IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem IPD_Data(nb)%Sfcprop%zorlo(ix) = tem + IPD_Data(nb)%Sfcprop%zorlw(ix) = tem + else + IPD_Data(nb)%Sfcprop%zorlw(ix) = -999.0_IPD_kind_phys endif enddo diff --git a/ccpp/physics b/ccpp/physics index 20336bff8..c2c4492d1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 20336bff8cf85d5e8026ca1e4513fb2cd049d3cb +Subproject commit c2c4492d1c137a54eae76a6aa3c83515a1e36f35 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 9cb6de297..ff12d1953 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1709,7 +1709,7 @@ subroutine GFS_physics_driver & Diag%u10m, Diag%v10m, Model%sfc_z0_type, & wet, dry, icy, tsfc3, tsurf3, snowd3, & ! --- input/output: - zorl3, uustar3, & + zorl3, Sfcprop%zorlw, uustar3, & ! --- outputs: cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23) ! cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23, wind, lprnt, ipr) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 3657b7e24..91680b8ce 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -246,6 +246,7 @@ module GFS_typedefs 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 :: zorli (:) => null() !< ice surface roughness in cm + real (kind=kind_phys), pointer :: zorlw (:) => null() !< wave 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 @@ -2222,6 +2223,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%zorlo (IM)) allocate (Sfcprop%zorll (IM)) allocate (Sfcprop%zorli (IM)) + allocate (Sfcprop%zorlw (IM)) allocate (Sfcprop%fice (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) @@ -2241,6 +2243,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%zorlo = clear_val Sfcprop%zorll = clear_val Sfcprop%zorli = clear_val + Sfcprop%zorlw = clear_val Sfcprop%fice = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index b15b2bc5d..79dc22fd7 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -547,6 +547,13 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys +[zorlw] + standard_name = surface_roughness_length_from_wave_model + long_name = surface roughness length from wave model + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys [fice] standard_name = sea_ice_concentration long_name = ice fraction over open water diff --git a/gfsphysics/physics/sfc_diff.f b/gfsphysics/physics/sfc_diff.f index c807595c5..9b56cdd33 100644 --- a/gfsphysics/physics/sfc_diff.f +++ b/gfsphysics/physics/sfc_diff.f @@ -12,9 +12,9 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) & flag_iter,redrag, !intent(in) & u10m,v10m,sfc_z0_type, !hafs,z0 type !intent(in) & wet,dry,icy, !intent(in) - & tskin, tsurf, snwdph, z0rl, ustar, + & tskin, tsurf, snwdph, z0rl, z0rlw, ustar ! - & cm, ch, rb, stress, fm, fh, fm10, fh2) + &, cm, ch, rb, stress, fm, fh, fm10, fh2) ! use physcons, rvrdm1 => con_fvirt implicit none @@ -36,6 +36,7 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) real(kind=kind_phys), dimension(im,3), intent(in) :: & tskin, tsurf, snwdph + real(kind=kind_phys), dimension(im), intent(in) :: z0rlw real(kind=kind_phys), dimension(im,3), intent(inout) :: & z0rl, ustar @@ -267,7 +268,7 @@ subroutine sfc_diff(im,ps,t1,q1,z1, wind, !intent(in) z0rl(i,3) = 1.0d-4 endif - elseif (z0rl(i,3) < 1.0d-7) then + elseif (z0rlw(i) < 1.0d-7) then z0 = (charnock / grav) * ustar(i,3) * ustar(i,3) if (redrag) then diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 9d903231e..95b372659 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -650,6 +650,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) else nvar_s2m = 32 endif + if (Model%cplwav) then + nvar_s2m = nvar_s2m + 1 + endif !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -803,8 +806,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if(Model%cplflx .or. Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell + endif + if(Model%frac_grid) then sfc_name2(35) = 'zorli' !zorl on land portion of a cell - end if + endif + if(Model%cplwav) then + sfc_name2(nvar_s2m) = 'zorlw' !zorl on land portion of a cell + endif !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) sfc_name2(nvar_s2m+1) = 'tref' @@ -877,7 +885,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' .or. trim(sfc_name2(num)) == 'zorli') then + if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & + .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlw') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -1041,8 +1050,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if(Model%cplflx .or. Model%frac_grid) then Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) + endif + if(Model%frac_grid) then Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) endif + if(Model%cplwav) then + Sfcprop(nb)%zorlw(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) + endif if(Model%frac_grid) then ! obtain slmsk from landfrac !! next 5 lines are temporary till lake model is available @@ -1303,6 +1317,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif + endif + if (Model%frac_grid) then if (sfc_var2(i,j,35) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') @@ -1313,7 +1329,17 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif - + endif + if (Model%frac_grid) then + if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') +!$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorlw(ix) = Sfcprop(nb)%zorlo(ix) !--- compute zorlw from existing variables + enddo + enddo + endif endif !#ifdef CCPP @@ -1668,6 +1694,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta else nvar2m = 32 endif + if (Model%cplwav) nvar2m = nvar2m + 1 nvar2o = 18 #ifdef CCPP if (Model%lsm == Model%lsm_ruc) then @@ -1781,11 +1808,16 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(31) = 'snoalb' !--- variables below here are optional sfc_name2(32) = 'sncovr' - if (Model%cplflx) then + if (Model%cplflx .or. Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell + endif + if (Model%frac_grid) then sfc_name2(35) = 'zorli' !zorl on land portion of a cell - end if + endif + if (Model%cplwav) then + sfc_name2(nvar2m) = 'zorlw' !zorl on land portion of a cell + endif !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) sfc_name2(nvar2m+1) = 'tref' sfc_name2(nvar2m+2) = 'z_c' @@ -1855,7 +1887,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' .or.trim(sfc_name2(num)) == 'zorli') then + if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' & + .or.trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlw') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -2002,8 +2035,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (Model%cplflx .or. Model%frac_grid) then sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) + endif + if (Model%frac_grid) then sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) - end if + endif + if (Model%cplwav) then + sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorli(ix) !--- zorlw (zorl from wav) + endif !--- NSSTM variables if (Model%nstf_name(1) > 0) then sfc_var2(i,j,nvar2m+1) = Sfcprop(nb)%tref(ix) !--- nsstm tref From 908b8f264e9b0ee6174f8dc8b22b5f1542fca17a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Jul 2020 11:12:48 +0000 Subject: [PATCH 065/217] updating gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index e2f4dc77a..7e60a274c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jul202020 + branch = SM_Jul212020 From 03004a999ea9ad488ac2553f08cfe36f3349d889 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 24 Jul 2020 01:45:26 +0000 Subject: [PATCH 066/217] After merging with fv3atm/develop and updating to latest dynamics --- .gitmodules | 2 +- atmos_model.F90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.gitmodules b/.gitmodules index 7e60a274c..491629970 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Jul092020 + branch = SM_Jul232020 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/SMoorthi-emc/ccpp-framework diff --git a/atmos_model.F90 b/atmos_model.F90 index 0b16ae69f..1300f9251 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -78,7 +78,7 @@ module atmos_model_mod use atmosphere_mod, only: atmosphere_scalar_field_halo use atmosphere_mod, only: atmosphere_get_bottom_layer use atmosphere_mod, only: set_atmosphere_pelist -use atmosphere_mod, only: Atm, mytile +use atmosphere_mod, only: Atm, mygrid use block_control_mod, only: block_control_type, define_blocks_packed use DYCORE_typedefs, only: DYCORE_data_type, DYCORE_diag_type #ifdef CCPP @@ -632,8 +632,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) Init_parm%area => Atmos%area Init_parm%tracer_names => tracer_names #ifdef CCPP - Init_parm%restart = Atm(mytile)%flagstruct%warm_start - Init_parm%hydrostatic = Atm(mytile)%flagstruct%hydrostatic + Init_parm%restart = Atm(mygrid)%flagstruct%warm_start + Init_parm%hydrostatic = Atm(mygrid)%flagstruct%hydrostatic #endif #ifdef INTERNAL_FILE_NML @@ -694,7 +694,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) endif endif - Atm(mytile)%flagstruct%do_skeb = IPD_Control%do_skeb + Atm(mygrid)%flagstruct%do_skeb = IPD_Control%do_skeb ! initialize the IAU module call iau_initialize (IPD_Control,IAU_data,Init_parm) @@ -715,7 +715,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call FV3GFS_diag_register (IPD_Diag, Time, Atm_block, IPD_Control, Atmos%lon, Atmos%lat, Atmos%axes) call IPD_initialize_rst (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) #ifdef CCPP - call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain, Atm(mytile)%flagstruct%warm_start) + call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain, Atm(mygrid)%flagstruct%warm_start) #else call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain) #endif From a7a306cef114059adcacf1844257e6a8eca56205 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Jul 2020 17:07:57 +0000 Subject: [PATCH 067/217] replacing post_gfs.F90 with develop version - note that this will NOT work with MG3 --- io/post_gfs.F90 | 922 +++++++++++++++++++++++------------------------- 1 file changed, 442 insertions(+), 480 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 248ce6d06..76dd0251c 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,20 +112,19 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -138,16 +137,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -240,62 +239,66 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -329,8 +332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng + pint, exch_h, ref_10cm use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -358,11 +360,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -387,12 +389,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -471,7 +473,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -482,7 +484,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -494,10 +496,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -505,7 +507,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -513,16 +514,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -597,7 +604,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -713,19 +720,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -737,17 +744,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -759,8 +768,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -768,27 +778,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -796,14 +808,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -812,58 +824,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j) = arrayr42d(i,j) +! pint(i,j)=arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -872,18 +884,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -894,114 +906,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1010,8 +1022,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1020,8 +1032,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1033,8 +1045,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1046,8 +1058,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1059,8 +1071,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1072,8 +1084,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1085,8 +1097,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1098,8 +1110,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1111,8 +1123,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1125,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1137,8 +1149,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1152,8 +1164,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1167,8 +1179,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1183,8 +1195,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1194,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1205,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1216,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1227,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1238,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1249,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1260,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1271,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1283,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1295,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1307,8 +1319,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1320,7 +1332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1329,8 +1341,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1339,8 +1351,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1350,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1360,8 +1372,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1370,8 +1382,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1380,8 +1392,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1390,8 +1402,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1400,8 +1412,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1410,8 +1422,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1421,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1431,8 +1443,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1441,8 +1453,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1452,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1463,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1475,8 +1487,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1486,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1497,30 +1509,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1529,8 +1541,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1539,8 +1551,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1549,8 +1561,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1559,30 +1571,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1592,8 +1604,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1603,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1617,8 +1629,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1631,8 +1643,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1642,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1653,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1663,8 +1675,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1673,8 +1685,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1683,8 +1695,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1693,8 +1705,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1703,8 +1715,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1713,8 +1725,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1723,8 +1735,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1733,8 +1745,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1743,8 +1755,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1754,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1764,8 +1776,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1775,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1785,8 +1797,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1795,8 +1807,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1805,8 +1817,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1816,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1826,8 +1838,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1837,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1847,8 +1859,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1857,8 +1869,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1867,8 +1879,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1877,8 +1889,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1887,8 +1899,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1897,8 +1909,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1907,8 +1919,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1917,8 +1929,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1927,8 +1939,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1937,8 +1949,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1947,8 +1959,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1957,8 +1969,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1968,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1979,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -1990,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2001,19 +2013,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2023,8 +2035,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2034,17 +2046,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2054,8 +2068,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2065,7 +2079,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2075,237 +2089,172 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP -! ------------------ - if (imp_physics == 10 .or. imp_physics == 11) then +! for GFDL MP + if (imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif ! for MG3 MP +!gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2313,12 +2262,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2326,7 +2275,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2352,33 +2302,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2386,23 +2349,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2428,13 +2390,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 - if( imp_physics == 10 .or. imp_physics == 11) then +! compute cwm for gfdlmp + if( imp_physics == 11 ) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2444,8 +2406,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2456,13 +2418,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend From 69f4033477942ec23054eb8c6583ef7e23ad2ddf Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Jul 2020 14:54:08 +0000 Subject: [PATCH 068/217] syncing submodule ccpp-physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index c2c4492d1..cfb269ced 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c2c4492d1c137a54eae76a6aa3c83515a1e36f35 +Subproject commit cfb269cedfc42a9016c18331cd9cf3bdba7f4a9f From 6fb21f113d737c881ac078deae7201dfadcfa961 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 3 Aug 2020 13:34:48 +0000 Subject: [PATCH 069/217] fixing issues related to z0 and restart reproducibility --- atmos_model.F90 | 2 + ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 28 +++-- gfsphysics/physics/gcycle.F90 | 16 ++- io/FV3GFS_io.F90 | 117 ++++++++++---------- 5 files changed, 91 insertions(+), 74 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 1300f9251..7c6962fe8 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1661,6 +1661,7 @@ subroutine assign_importdata(rc) real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 real(kind=IPD_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice + real (kind=IPD_kind_phys), parameter :: z0ice=0.011 ! !------------------------------------------------------------------------------ ! @@ -2006,6 +2007,7 @@ subroutine assign_importdata(rc) IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & / max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix)) ! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) + IPD_Data(nb)%Sfcprop%zorli(ix) = z0ice else ! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix) IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Sfcprop%tsfco(ix) diff --git a/ccpp/physics b/ccpp/physics index cfb269ced..e53009676 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cfb269cedfc42a9016c18331cd9cf3bdba7f4a9f +Subproject commit e530096764773b67fa30c7f3b11285c81bb5374d diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index ff12d1953..715f91ddd 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -649,6 +649,7 @@ subroutine GFS_physics_driver & hflxq, evapq, hffac, hefac real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + real (kind=kind_phys), parameter :: z0ice=0.011 ! !=============================================================================== @@ -1224,19 +1225,20 @@ subroutine GFS_physics_driver & gabsbdlw3(i,k) = zero enddo enddo + zorl3(:,2) = z0ice - if (.not. Model%cplflx .or. .not. Model%frac_grid) then - 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 +! if (.not. Model%cplflx .or. .not. Model%frac_grid) then +! 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 ! if (lprnt) write(0,*)' dry=',dry(ipr),' wet=',wet(ipr),' icy=',icy(ipr) ,& ! ' tsfco=',Sfcprop%tsfco(ipr) do i=1,im @@ -2236,11 +2238,13 @@ subroutine GFS_physics_driver & stress(i) = txi *stress3(i,2) + txo * stress3(i,3) qss(i) = txi * qss3(i,2) + txo * qss3(i,3) ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) + Sfcprop%zorl(i) = txi*zorl3(i,2) + txo*zorl3(i,3) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) Sfcprop%hice(i) = zice(i) Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen + Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3) else ! this would be over open ocean or land (no ice fraction) Sfcprop%hice(i) = zero Sfcprop%fice(i) = zero diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 8e799fb12..64d234091 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -102,7 +102,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TSFFCS(len) = Sfcprop(nb)%tsfc (ix) endif SNOFCS (len) = Sfcprop(nb)%weasd (ix) - ZORFCS (len) = Sfcprop(nb)%zorl (ix) + ZORFCS (len) = Sfcprop(nb)%zorll (ix) + if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then + ZORFCS (len) = Sfcprop(nb)%zorli (ix) + elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then + ZORFCS (len) = Sfcprop(nb)%zorlo (ix) + endif TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) ! F10MFCS (len) = Sfcprop(nb)%f10m (ix) @@ -210,7 +215,12 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) - Sfcprop(nb)%zorl (ix) = ZORFCS (len) + Sfcprop(nb)%zorll (ix) = ZORFCS (len) + if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then + Sfcprop(nb)%zorli(ix) = ZORFCS (len) + elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then + Sfcprop(nb)%zorlo(ix) = ZORFCS (len) + endif Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) ! Sfcprop(nb)%f10m (ix) = F10MFCS (len) @@ -243,7 +253,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%slc (ix,ls) = SLCFC1 (ll) if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (ll) enddo - ENDDO !-----END BLOCK SIZE LOOP------------------------------ + ENDDO !-----END BLOCK SIZE LOOP-------------------------- ENDDO !-----END BLOCK LOOP------------------------------- ! check diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 95b372659..e0898c3f6 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -643,13 +643,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo - if (Model%frac_grid) then ! needs more variables +! if (Model%frac_grid) then ! needs more variables nvar_s2m = 35 - elseif (Model%cplflx) then ! needs more variables - nvar_s2m = 34 - else - nvar_s2m = 32 - endif +! else +! nvar_s2m = 32 +! endif if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif @@ -803,13 +801,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) sfc_name2(31) = 'snoalb' !--- variables below here are optional sfc_name2(32) = 'sncovr' - if(Model%cplflx .or. Model%frac_grid) then +! if(Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell - endif - if(Model%frac_grid) then sfc_name2(35) = 'zorli' !zorl on land portion of a cell - endif +! endif if(Model%cplwav) then sfc_name2(nvar_s2m) = 'zorlw' !zorl on land portion of a cell endif @@ -1047,15 +1043,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%slope(ix) = sfc_var2(i,j,30) !--- slope Sfcprop(nb)%snoalb(ix) = sfc_var2(i,j,31) !--- snoalb Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr - if(Model%cplflx .or. Model%frac_grid) then +! if(Model%frac_grid) then Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) - endif - if(Model%frac_grid) then Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) - endif +! else +! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) +! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) +! endif if(Model%cplwav) then Sfcprop(nb)%zorlw(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) + else + Sfcprop(nb)%zorlw(ix) = Sfcprop(nb)%zorlo(ix) endif if(Model%frac_grid) then ! obtain slmsk from landfrac @@ -1073,7 +1073,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) else Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) endif - end if + endif if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell @@ -1296,7 +1296,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo endif - if (Model%cplflx .or. Model%frac_grid) then +! if (Model%frac_grid) then if (sfc_var2(i,j,33) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') @@ -1317,8 +1317,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif - endif - if (Model%frac_grid) then if (sfc_var2(i,j,35) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') @@ -1329,8 +1327,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif - endif - if (Model%frac_grid) then + if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') !$omp parallel do default(shared) private(nb, ix) @@ -1340,20 +1337,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo endif - endif - -!#ifdef CCPP - if (nint(sfc_var3ice(1,1,1)) == -9999) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tiice(ix,1) = Sfcprop(nb)%stc(ix,1) !--- initialize internal ice temp from soil temp at layer 1 - Sfcprop(nb)%tiice(ix,2) = Sfcprop(nb)%stc(ix,2) !--- initialize internal ice temp from soil temp at layer 2 - enddo - enddo - endif -!#endif !#endif if(Model%frac_grid) then ! 3-way composite @@ -1377,15 +1361,38 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo - Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) - Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) - Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) +! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) +! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + else + tem = one - Sfcprop(nb)%fice(ix) + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%zorlo(ix) * tem + + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%tsfco(ix) * tem + endif enddo enddo endif ! if (Model%frac_grid) +!#ifdef CCPP + if (nint(sfc_var3ice(1,1,1)) == -9999) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tiice(ix,1) = Sfcprop(nb)%stc(ix,1) !--- initialize internal ice temp from soil temp at layer 1 + Sfcprop(nb)%tiice(ix,2) = Sfcprop(nb)%stc(ix,2) !--- initialize internal ice temp from soil temp at layer 2 + enddo + enddo + endif +!#endif + if (Model%lsm == Model%lsm_noahmp) then if (nint(sfc_var2(1,1,nvar_s2m+19)) == -66666) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver:: - Cold start Noah MP ') @@ -1687,13 +1694,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p2 => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() - if (Model%frac_grid) then ! needs more variables +! if (Model%frac_grid) then ! needs more variables nvar2m = 35 - elseif (Model%cplflx) then ! needs more variables - nvar2m = 34 - else - nvar2m = 32 - endif +! else +! nvar2m = 32 +! endif if (Model%cplwav) nvar2m = nvar2m + 1 nvar2o = 18 #ifdef CCPP @@ -1808,13 +1813,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(31) = 'snoalb' !--- variables below here are optional sfc_name2(32) = 'sncovr' - if (Model%cplflx .or. Model%frac_grid) then +! if (Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell - endif - if (Model%frac_grid) then sfc_name2(35) = 'zorli' !zorl on land portion of a cell - endif +! endif if (Model%cplwav) then sfc_name2(nvar2m) = 'zorlw' !zorl on land portion of a cell endif @@ -1995,13 +1998,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 sfc_var2(i,j,1) = Sfcprop(nb)%slmsk(ix) !--- slmsk - if (Model%frac_grid) then +! if (Model%frac_grid) then sfc_var2(i,j,2) = Sfcprop(nb)%tsfco(ix) !--- tsfc (tsea in sfc file) sfc_var2(i,j,5) = Sfcprop(nb)%zorlo(ix) !--- zorlo - else - sfc_var2(i,j,2) = Sfcprop(nb)%tsfc(ix) !--- tsfc (tsea in sfc file) - sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl - endif +! else +! sfc_var2(i,j,2) = Sfcprop(nb)%tsfc(ix) !--- tsfc (tsea in sfc file) +! sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl +! endif sfc_var2(i,j,3) = Sfcprop(nb)%weasd(ix) !--- weasd (sheleg in sfc file) sfc_var2(i,j,4) = Sfcprop(nb)%tg3(ix) !--- tg3 ! sfc_var2(i,j,5) = Sfcprop(nb)%zorl(ix) !--- zorl @@ -2032,15 +2035,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,30) = Sfcprop(nb)%slope(ix) !--- slope sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix)!--- sncovr - if (Model%cplflx .or. Model%frac_grid) then +! if (Model%frac_grid) then sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) - endif - if (Model%frac_grid) then sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) - endif +! endif if (Model%cplwav) then - sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorli(ix) !--- zorlw (zorl from wav) + sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlw(ix) !--- zorlw (zorl from wav) endif !--- NSSTM variables if (Model%nstf_name(1) > 0) then From 51cce857767ef485e701209b52d067b76b256821 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 3 Aug 2020 13:38:47 +0000 Subject: [PATCH 070/217] after submodule sync --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 491629970..c3ceea468 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jul212020 + branch = SM_Jul302020 diff --git a/ccpp/physics b/ccpp/physics index e53009676..4b11e8491 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e530096764773b67fa30c7f3b11285c81bb5374d +Subproject commit 4b11e849183fa7635c0db6fd0631159159ec126c From 7cb03c42169fab3b974770f3dc093d18415a8912 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 Aug 2020 14:04:49 +0000 Subject: [PATCH 071/217] changing post_gfs back to the version that works with double moment microphysics - i.e. MGx schemes --- io/post_gfs.F90 | 922 +++++++++++++++++++++++++----------------------- 1 file changed, 480 insertions(+), 442 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 76dd0251c..248ce6d06 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,19 +112,20 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -137,16 +138,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. + setvar_atmfile = .false. + setvar_sfcfile = .false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP +! 20190807 need to call microinit only for Ferrier microphysics ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -239,66 +240,62 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n>1) then + else if(n > 1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then + else if(trim(attName) == "bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n>1) then - if(trim(attName) =="ak") then + else if(n > 1) then + if(trim(attName) == "ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -332,7 +329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -360,11 +358,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -389,12 +387,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -473,7 +471,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -484,7 +482,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -496,10 +494,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -507,6 +505,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs + dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -514,22 +513,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL - enddo - enddo -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? enddo enddo @@ -604,7 +597,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -720,19 +713,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -744,19 +737,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -768,9 +759,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -778,29 +768,27 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -808,14 +796,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -824,58 +812,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j)=arrayr42d(i,j) + fis(i,j) = arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) +!!$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j)=arrayr42d(i,j) +! pint(i,j) = arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j)=arrayr42d(i,j) + pblh(i,j) = arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j)=arrayr42d(i,j) + ustar(i,j) = arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j)=arrayr42d(i,j) + z0(i,j) = arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -884,18 +872,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j)=arrayr42d(i,j) + acond(i,j) = arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -906,114 +894,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1022,8 +1010,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1032,8 +1020,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1045,8 +1033,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1058,8 +1046,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1071,8 +1059,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1084,8 +1072,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1097,8 +1085,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1110,8 +1098,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1123,8 +1111,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1137,8 +1125,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1149,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1164,8 +1152,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1179,8 +1167,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1195,8 +1183,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1206,8 +1194,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1217,8 +1205,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1228,8 +1216,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1239,8 +1227,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1250,8 +1238,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1261,8 +1249,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1272,8 +1260,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1283,8 +1271,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1295,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1307,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1319,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1332,7 +1320,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1341,8 +1329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1351,8 +1339,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1362,8 +1350,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1372,8 +1360,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1382,8 +1370,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1392,8 +1380,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1402,8 +1390,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1412,8 +1400,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1422,8 +1410,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1433,8 +1421,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1443,8 +1431,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1453,8 +1441,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1464,8 +1452,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1475,8 +1463,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1487,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1498,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1509,30 +1497,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1541,8 +1529,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1551,8 +1539,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1561,8 +1549,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1571,30 +1559,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1604,8 +1592,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1615,8 +1603,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1629,8 +1617,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1643,8 +1631,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1654,8 +1642,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1665,8 +1653,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1675,8 +1663,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1685,8 +1673,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1695,8 +1683,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1705,8 +1693,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1715,8 +1703,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1725,8 +1713,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1735,8 +1723,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1745,8 +1733,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1755,8 +1743,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1766,8 +1754,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1776,8 +1764,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1787,8 +1775,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1797,8 +1785,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1807,8 +1795,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1817,8 +1805,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1828,8 +1816,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1838,8 +1826,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1849,8 +1837,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1859,8 +1847,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1869,8 +1857,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1879,8 +1867,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1889,8 +1877,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1899,8 +1887,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1909,8 +1897,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1919,8 +1907,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1929,8 +1917,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1939,8 +1927,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1949,8 +1937,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1959,8 +1947,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1969,8 +1957,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1980,8 +1968,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1991,8 +1979,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2002,8 +1990,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2013,19 +2001,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval enddo enddo endif ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2035,8 +2023,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2046,19 +2034,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then + else if (fieldDimCount == 3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2068,8 +2054,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2079,7 +2065,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2089,172 +2075,237 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) + q(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) + uh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) + vh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) + dpres(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) + zint(i,j,l) = -arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) + wh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) + o3(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL MP - if (imp_physics == 11) then +! for GFDL or MG3 MP +! ------------------ + if (imp_physics == 10 .or. imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) + qqw(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) + qqi(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) + qqr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) + qqs(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqns(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -!gfdlmp - endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif ! for MG3 MP ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) + cfr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) + ref_10cm(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2262,12 +2313,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) + q2(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2275,8 +2326,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif -! end loop ncount_field - enddo + enddo ! end loop ncount_field if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2302,46 +2352,33 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - end do - end do + pd(i,j) = spval + enddo + enddo do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) !compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) enddo enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2349,22 +2386,23 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2390,13 +2428,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp - if( imp_physics == 11 ) then +! compute cwm for gfdlmp or MG3 + if( imp_physics == 10 .or. imp_physics == 11) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) enddo enddo enddo @@ -2406,8 +2444,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2418,13 +2456,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l + htop(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! hbot do j=jsta,jend From 7c258bd80bba7ef20f475fac4fb9b0ddcc7a770b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 Aug 2020 15:18:00 +0000 Subject: [PATCH 072/217] changing z0ice to cm --- atmos_model.F90 | 2 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 7c6962fe8..b31e0352f 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1661,7 +1661,7 @@ subroutine assign_importdata(rc) real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 real(kind=IPD_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice - real (kind=IPD_kind_phys), parameter :: z0ice=0.011 + real (kind=IPD_kind_phys), parameter :: z0ice=1.1 ! (in cm) ! !------------------------------------------------------------------------------ ! diff --git a/ccpp/physics b/ccpp/physics index 4b11e8491..04f660ba4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4b11e849183fa7635c0db6fd0631159159ec126c +Subproject commit 04f660ba4e305028a3c8064239619266971226d6 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 715f91ddd..02eb00e00 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -649,7 +649,7 @@ subroutine GFS_physics_driver & hflxq, evapq, hffac, hefac real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 - real (kind=kind_phys), parameter :: z0ice=0.011 + real (kind=kind_phys), parameter :: z0ice=1.1 ! !=============================================================================== From a77396a1ae7dcd6444aa580f5bc143ec4a430c77 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 Aug 2020 15:22:42 +0000 Subject: [PATCH 073/217] changing z0ice to cm --- atmos_model.F90 | 2 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 7c6962fe8..b31e0352f 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1661,7 +1661,7 @@ subroutine assign_importdata(rc) real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8 real(kind=IPD_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice - real (kind=IPD_kind_phys), parameter :: z0ice=0.011 + real (kind=IPD_kind_phys), parameter :: z0ice=1.1 ! (in cm) ! !------------------------------------------------------------------------------ ! diff --git a/ccpp/physics b/ccpp/physics index 4b11e8491..04f660ba4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4b11e849183fa7635c0db6fd0631159159ec126c +Subproject commit 04f660ba4e305028a3c8064239619266971226d6 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 715f91ddd..02eb00e00 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -649,7 +649,7 @@ subroutine GFS_physics_driver & hflxq, evapq, hffac, hefac real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 - real (kind=kind_phys), parameter :: z0ice=0.011 + real (kind=kind_phys), parameter :: z0ice=1.1 ! !=============================================================================== From 0e660373bced07d3aa239b9f0c67a98d1f62c622 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 11:05:01 -0400 Subject: [PATCH 074/217] after updating sfcsub.F in ccpp-physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index b9ff5e713..d3dcae7ea 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit b9ff5e713a8e5f1b5c8863b624c0c6522b6532b4 +Subproject commit d3dcae7ea20e27b9f4c774cea52acf7389e6d9e9 From e0b7e3778fc41da9766e8dcf93463fa6282b3c36 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 12:16:23 -0400 Subject: [PATCH 075/217] a fix in wv_saturation.F - impact on resuls --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index d3dcae7ea..c3ddc93d8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d3dcae7ea20e27b9f4c774cea52acf7389e6d9e9 +Subproject commit c3ddc93d88012e45daca4b115b83074c019fb8bb From 956d06b0b3860d43814cbf99c80c761644483c70 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 Aug 2020 12:48:24 -0400 Subject: [PATCH 076/217] moving definition of kp inside ifdef in wv_saturation.F --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index c3ddc93d8..f3b797ffd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c3ddc93d88012e45daca4b115b83074c019fb8bb +Subproject commit f3b797ffda59e9c0e0fe02b15564f530ef569229 From ee2a35fc0efd17aac81878beb55b89eeba106350 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 11 Aug 2020 10:10:17 -0400 Subject: [PATCH 077/217] updating gitmodules --- .gitmodules | 8 ++++---- ccpp/physics | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index c3ceea468..ad41e5c86 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,11 +1,11 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Jul232020 + url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere + branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework - url = https://github.com/SMoorthi-emc/ccpp-framework - branch = SM_Jul092020 + url = https://github.com/NCAR/ccpp-framework + branch = master [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics diff --git a/ccpp/physics b/ccpp/physics index 04f660ba4..f3b797ffd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 04f660ba4e305028a3c8064239619266971226d6 +Subproject commit f3b797ffda59e9c0e0fe02b15564f530ef569229 From 515308e3912e72bc8166b95b06c9000e515e70c0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 24 Aug 2020 01:00:32 +0000 Subject: [PATCH 078/217] changing ver=3 to ver=4 in suite_FV3_GFS_cpld_rasmgshocnsst.xml --- ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml index 5b3b63528..a08956dfa 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml @@ -1,6 +1,6 @@ - + From 824b63453c214474f1b0c8705537c5ef5d665ce9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 Aug 2020 00:49:51 +0000 Subject: [PATCH 079/217] updatin gitmodules --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index ad41e5c86..8b16cb27c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Jul302020 + branch = SM_Aug252020 diff --git a/ccpp/physics b/ccpp/physics index f3b797ffd..8617587ed 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f3b797ffda59e9c0e0fe02b15564f530ef569229 +Subproject commit 8617587edb95aa097b7bbc2735990393bc6d9b90 From 697ad6bb9ae3fdd750256d3c72c8e25b2cc9d466 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 31 Aug 2020 00:34:44 +0000 Subject: [PATCH 080/217] updating .gitmodules --- .gitmodules | 4 ++-- atmos_cubed_sphere | 2 +- ccpp/driver/CCPP_driver.F90 | 12 ++++++------ ccpp/physics | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8b16cb27c..f5955ffb8 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere - branch = dev/emc + url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere + branch = SM_Aug272020 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 8b59ebc03..93943e585 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 8b59ebc039dafe1c20ed6dd21cb38ca564852b98 +Subproject commit 93943e5855a85e9cd0b28b679c2da4cc16938e60 diff --git a/ccpp/driver/CCPP_driver.F90 b/ccpp/driver/CCPP_driver.F90 index 8e45d9382..89c41672f 100644 --- a/ccpp/driver/CCPP_driver.F90 +++ b/ccpp/driver/CCPP_driver.F90 @@ -93,7 +93,7 @@ subroutine CCPP_step (step, nblks, ierr) end do end do - else if (trim(step)=="physics_init") then + else if (trim(step)=="physics_init") then ! Since the physics init steps are independent of the blocking structure, ! we can use cdata_domain here. Since we don't use threading on the outside, @@ -107,7 +107,7 @@ subroutine CCPP_step (step, nblks, ierr) return end if - else if (trim(step)=="time_vary") then + else if (trim(step)=="time_vary") then ! Since the time_vary steps only use data structures for all blocks (except the ! CCPP-internal variables ccpp_error_flag and ccpp_error_message, which are defined @@ -123,8 +123,8 @@ subroutine CCPP_step (step, nblks, ierr) return end if - ! Radiation and stochastic physics - else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then + ! Radiation and stochastic physics + else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then ! Set number of threads available to physics schemes to one, ! because threads are used on the outside for blocking @@ -162,8 +162,8 @@ subroutine CCPP_step (step, nblks, ierr) !$OMP end parallel if (ierr/=0) return - ! Finalize - else if (trim(step)=="finalize") then + ! Finalize + else if (trim(step)=="finalize") then ! Loop over blocks, don't use threading on the outside but allowing threading ! inside the finalization, similar to what is done for the initialization diff --git a/ccpp/physics b/ccpp/physics index 8617587ed..f94cc6105 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8617587edb95aa097b7bbc2735990393bc6d9b90 +Subproject commit f94cc61050e504279e29d22d0ef2b248be8e3be7 From e9ef74759cfe682ca21d671327977d922756e0a8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 1 Sep 2020 16:28:23 +0000 Subject: [PATCH 081/217] fix some tsfc related issues --- atmos_model.F90 | 18 +++++++------- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 6 +++-- gfsphysics/GFS_layer/GFS_typedefs.F90 | 4 ++-- io/FV3GFS_io.F90 | 26 ++++++++++++--------- 4 files changed, 31 insertions(+), 23 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 900c9143e..0948b00a8 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -99,13 +99,13 @@ module atmos_model_mod IPD_interstitial => GFS_interstitial use IPD_driver, only: IPD_initialize, IPD_initialize_rst use CCPP_driver, only: CCPP_step, non_uniform_blocks + +use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper #else use IPD_driver, only: IPD_initialize, IPD_initialize_rst, IPD_step use physics_abstraction_layer, only: time_vary_step, radiation_step1, physics_step1, physics_step2 #endif -use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper - use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, & FV3GFS_IPD_checksum, & FV3GFS_diag_register, FV3GFS_diag_output, & @@ -291,14 +291,15 @@ subroutine update_atmos_radiation_physics (Atmos) #ifdef CCPP call CCPP_step (step="time_vary", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP time_vary step failed') + +!--- call stochastic physics pattern generation / cellular automata + call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block) + #else Func1d => time_vary_step call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d) #endif -!--- call stochastic physics pattern generation / cellular automata - call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block) - !--- if coupled, assign coupled fields if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then @@ -623,13 +624,14 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) #ifdef CCPP call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, & IPD_Interstitial, commglobal, mpp_npes(), Init_parm) -#else - call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) -#endif !--- Initialize stochastic physics pattern generation / cellular automata for first time step call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block) +#else + call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm) +#endif + Atmos%Diag => IPD_Diag Atm(mygrid)%flagstruct%do_skeb = IPD_Control%do_skeb diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 02eb00e00..05dcdcdb6 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -2191,6 +2191,7 @@ subroutine GFS_physics_driver & ! Sfcprop%tprcp(i) = tprcp3(i,1) Sfcprop%tsfco(i) = tsfc3(i,1) Sfcprop%tisfc(i) = tsfc3(i,1) + Sfcprop%tsfc(i) = tsfc3(i,1) elseif (islmsk(i) == 0) then k = 3 Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled) @@ -2198,6 +2199,7 @@ subroutine GFS_physics_driver & ! Sfcprop%tprcp(i) = tprcp3(i,3) Sfcprop%tisfc(i) = tsfc3(i,3) Sfcprop%tsfcl(i) = tsfc3(i,3) + Sfcprop%tsfc(i) = tsfc3(i,3) else k = 2 stress(i) = stress3(i,2) @@ -2222,7 +2224,7 @@ subroutine GFS_physics_driver & evap(i) = evap3(i,k) hflx(i) = hflx3(i,k) qss(i) = qss3(i,k) - Sfcprop%tsfc(i) = tsfc3(i,k) +! Sfcprop%tsfc(i) = tsfc3(i,k) Sfcprop%zorll(i) = zorl3(i,1) Sfcprop%zorli(i) = zorl3(i,2) @@ -2238,7 +2240,7 @@ subroutine GFS_physics_driver & stress(i) = txi *stress3(i,2) + txo * stress3(i,3) qss(i) = txi * qss3(i,2) + txo * qss3(i,3) ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) - Sfcprop%zorl(i) = txi*zorl3(i,2) + txo*zorl3(i,3) + Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 3c1252b1e..5545781fd 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1551,9 +1551,9 @@ module GFS_typedefs #ifdef CCPP real (kind=kind_phys), pointer :: TRAIN (:,:) => null() !< accumulated stratiform T tendency (K s-1) #endif -#ifdef CCPP +!#ifdef CCPP real (kind=kind_phys), pointer :: cldfra (:,:) => null() !< instantaneous 3D cloud fraction -#endif +!#endif !--- MP quantities for 3D diagnositics real (kind=kind_phys), pointer :: refl_10cm(:,:) => null() !< instantaneous refl_10cm ! diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index e0898c3f6..472f941ea 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1077,16 +1077,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then - Sfcprop(nb)%fice(ix) = zero - if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 - endif +! if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then +! Sfcprop(nb)%fice(ix) = zero +! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 +! endif else Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then - Sfcprop(nb)%fice(ix) = zero - if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 - endif +! if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then +! Sfcprop(nb)%fice(ix) = zero +! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 +! endif endif ! !--- NSSTM variables @@ -1365,7 +1365,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) ! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) ! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) ! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) -! Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) if (Sfcprop(nb)%slmsk(ix) == 1) then Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) @@ -1374,8 +1374,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & + Sfcprop(nb)%zorlo(ix) * tem - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & - + Sfcprop(nb)%tsfco(ix) * tem + if (Sfcprop(nb)%fice(ix) > min(Model%min_seaice,Model%min_lakeice)) then + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + endif + +! Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & +! + Sfcprop(nb)%tsfco(ix) * tem endif enddo enddo From 70dc9b8f82ddd15148e277103162e0388a0bfe55 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 3 Sep 2020 16:33:52 +0000 Subject: [PATCH 082/217] creating a new brnach for restart fix PR --- .gitmodules | 8 ++++---- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.gitmodules b/.gitmodules index f5955ffb8..d253f6966 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,12 +1,12 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Aug272020 + 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 branch = master [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SMoorthi-EMC/ccpp-physics - branch = SM_Aug252020 + url = https://github.com/NCAR/ccpp-physics + branch = master diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 93943e585..8b59ebc03 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 93943e5855a85e9cd0b28b679c2da4cc16938e60 +Subproject commit 8b59ebc039dafe1c20ed6dd21cb38ca564852b98 diff --git a/ccpp/physics b/ccpp/physics index f94cc6105..c555881c1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f94cc61050e504279e29d22d0ef2b248be8e3be7 +Subproject commit c555881c1a710d9090f2bdea78f6a5c663f3148a From 445e5d344de1e95d9332422ae6201809fd9a7654 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 4 Sep 2020 10:50:30 +0000 Subject: [PATCH 083/217] fixing a compilation bug --- atmos_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 0cb77f805..a0a9b3895 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -293,8 +293,8 @@ subroutine update_atmos_radiation_physics (Atmos) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP time_vary step failed') !--- call stochastic physics pattern generation / cellular automata - call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block) - if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') + call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') #else Func1d => time_vary_step From 26887d664b8ab9bbf684767abed0efb027b3854f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 4 Sep 2020 15:43:53 +0000 Subject: [PATCH 084/217] replacing post_gfs.F90 by fv3atm/develop version --- io/post_gfs.F90 | 922 +++++++++++++++++++++++------------------------- 1 file changed, 442 insertions(+), 480 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 248ce6d06..76dd0251c 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,20 +112,19 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -138,16 +137,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -240,62 +239,66 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -329,8 +332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng + pint, exch_h, ref_10cm use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -358,11 +360,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -387,12 +389,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -471,7 +473,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -482,7 +484,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -494,10 +496,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -505,7 +507,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -513,16 +514,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -597,7 +604,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -713,19 +720,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -737,17 +744,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -759,8 +768,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -768,27 +778,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -796,14 +808,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -812,58 +824,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j) = arrayr42d(i,j) +! pint(i,j)=arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -872,18 +884,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -894,114 +906,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1010,8 +1022,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1020,8 +1032,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1033,8 +1045,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1046,8 +1058,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1059,8 +1071,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1072,8 +1084,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1085,8 +1097,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1098,8 +1110,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1111,8 +1123,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1125,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1137,8 +1149,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1152,8 +1164,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1167,8 +1179,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1183,8 +1195,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1194,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1205,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1216,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1227,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1238,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1249,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1260,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1271,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1283,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1295,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1307,8 +1319,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1320,7 +1332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1329,8 +1341,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1339,8 +1351,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1350,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1360,8 +1372,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1370,8 +1382,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1380,8 +1392,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1390,8 +1402,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1400,8 +1412,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1410,8 +1422,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1421,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1431,8 +1443,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1441,8 +1453,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1452,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1463,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1475,8 +1487,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1486,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1497,30 +1509,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1529,8 +1541,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1539,8 +1551,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1549,8 +1561,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1559,30 +1571,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1592,8 +1604,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1603,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1617,8 +1629,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1631,8 +1643,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1642,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1653,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1663,8 +1675,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1673,8 +1685,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1683,8 +1695,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1693,8 +1705,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1703,8 +1715,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1713,8 +1725,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1723,8 +1735,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1733,8 +1745,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1743,8 +1755,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1754,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1764,8 +1776,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1775,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1785,8 +1797,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1795,8 +1807,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1805,8 +1817,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1816,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1826,8 +1838,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1837,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1847,8 +1859,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1857,8 +1869,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1867,8 +1879,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1877,8 +1889,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1887,8 +1899,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1897,8 +1909,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1907,8 +1919,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1917,8 +1929,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1927,8 +1939,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1937,8 +1949,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1947,8 +1959,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1957,8 +1969,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1968,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1979,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -1990,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2001,19 +2013,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2023,8 +2035,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2034,17 +2046,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2054,8 +2068,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2065,7 +2079,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2075,237 +2089,172 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP -! ------------------ - if (imp_physics == 10 .or. imp_physics == 11) then +! for GFDL MP + if (imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif ! for MG3 MP +!gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2313,12 +2262,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2326,7 +2275,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2352,33 +2302,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2386,23 +2349,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2428,13 +2390,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 - if( imp_physics == 10 .or. imp_physics == 11) then +! compute cwm for gfdlmp + if( imp_physics == 11 ) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2444,8 +2406,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2456,13 +2418,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend From 9c98799acf4a20d6ac73ce030af0c3e8e533f4ed Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 5 Sep 2020 01:23:20 +0000 Subject: [PATCH 085/217] updating FV3GFS_io.F90 to retain original code for cold start --- io/FV3GFS_io.F90 | 57 ++++++++++++++++++++++++++++++------------------ 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 472f941ea..329eac5ec 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1357,32 +1357,47 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo else + if (Model%kdt <= 0) then !$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo -! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) -! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) -! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) -! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) - if (Sfcprop(nb)%slmsk(ix) == 1) then - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) - else - tem = one - Sfcprop(nb)%fice(ix) - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & - + Sfcprop(nb)%zorlo(ix) * tem - - if (Sfcprop(nb)%fice(ix) > min(Model%min_seaice,Model%min_lakeice)) then +! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) +! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) +! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + else + tem = one - Sfcprop(nb)%fice(ix) + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%zorlo(ix) * tem + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%tsfco(ix) * tem endif - -! Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & -! + Sfcprop(nb)%tsfco(ix) * tem - endif + enddo enddo - enddo + else +!$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + else + tem = one - Sfcprop(nb)%fice(ix) + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%zorlo(ix) * tem + if (Sfcprop(nb)%fice(ix) > min(Model%min_seaice,Model%min_lakeice)) then + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + endif + endif + enddo + enddo + endif endif ! if (Model%frac_grid) !#ifdef CCPP From 5a483852bccd4542f7fce6ccb262d6012fb7a263 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 6 Sep 2020 00:24:15 +0000 Subject: [PATCH 086/217] copy of branch SM_Sep022020 with my version of post_gfs.F90 --- io/post_gfs.F90 | 922 +++++++++++++++++++++++++----------------------- 1 file changed, 480 insertions(+), 442 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 76dd0251c..248ce6d06 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,19 +112,20 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -137,16 +138,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. + setvar_atmfile = .false. + setvar_sfcfile = .false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP +! 20190807 need to call microinit only for Ferrier microphysics ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -239,66 +240,62 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n>1) then + else if(n > 1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then + else if(trim(attName) == "bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n>1) then - if(trim(attName) =="ak") then + else if(n > 1) then + if(trim(attName) == "ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -332,7 +329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -360,11 +358,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -389,12 +387,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -473,7 +471,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -484,7 +482,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -496,10 +494,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -507,6 +505,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs + dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -514,22 +513,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL - enddo - enddo -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? enddo enddo @@ -604,7 +597,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -720,19 +713,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -744,19 +737,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -768,9 +759,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -778,29 +768,27 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -808,14 +796,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -824,58 +812,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j)=arrayr42d(i,j) + fis(i,j) = arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) +!!$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j)=arrayr42d(i,j) +! pint(i,j) = arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j)=arrayr42d(i,j) + pblh(i,j) = arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j)=arrayr42d(i,j) + ustar(i,j) = arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j)=arrayr42d(i,j) + z0(i,j) = arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -884,18 +872,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j)=arrayr42d(i,j) + acond(i,j) = arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -906,114 +894,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1022,8 +1010,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1032,8 +1020,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1045,8 +1033,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1058,8 +1046,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1071,8 +1059,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1084,8 +1072,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1097,8 +1085,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1110,8 +1098,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1123,8 +1111,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1137,8 +1125,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1149,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1164,8 +1152,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1179,8 +1167,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1195,8 +1183,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1206,8 +1194,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1217,8 +1205,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1228,8 +1216,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1239,8 +1227,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1250,8 +1238,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1261,8 +1249,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1272,8 +1260,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1283,8 +1271,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1295,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1307,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1319,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1332,7 +1320,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1341,8 +1329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1351,8 +1339,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1362,8 +1350,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1372,8 +1360,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1382,8 +1370,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1392,8 +1380,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1402,8 +1390,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1412,8 +1400,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1422,8 +1410,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1433,8 +1421,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1443,8 +1431,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1453,8 +1441,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1464,8 +1452,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1475,8 +1463,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1487,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1498,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1509,30 +1497,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1541,8 +1529,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1551,8 +1539,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1561,8 +1549,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1571,30 +1559,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1604,8 +1592,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1615,8 +1603,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1629,8 +1617,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1643,8 +1631,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1654,8 +1642,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1665,8 +1653,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1675,8 +1663,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1685,8 +1673,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1695,8 +1683,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1705,8 +1693,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1715,8 +1703,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1725,8 +1713,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1735,8 +1723,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1745,8 +1733,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1755,8 +1743,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1766,8 +1754,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1776,8 +1764,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1787,8 +1775,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1797,8 +1785,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1807,8 +1795,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1817,8 +1805,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1828,8 +1816,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1838,8 +1826,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1849,8 +1837,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1859,8 +1847,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1869,8 +1857,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1879,8 +1867,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1889,8 +1877,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1899,8 +1887,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1909,8 +1897,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1919,8 +1907,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1929,8 +1917,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1939,8 +1927,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1949,8 +1937,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1959,8 +1947,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1969,8 +1957,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1980,8 +1968,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1991,8 +1979,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2002,8 +1990,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2013,19 +2001,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval enddo enddo endif ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2035,8 +2023,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2046,19 +2034,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then + else if (fieldDimCount == 3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2068,8 +2054,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2079,7 +2065,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2089,172 +2075,237 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) + q(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) + uh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) + vh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) + dpres(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) + zint(i,j,l) = -arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) + wh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) + o3(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL MP - if (imp_physics == 11) then +! for GFDL or MG3 MP +! ------------------ + if (imp_physics == 10 .or. imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) + qqw(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) + qqi(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) + qqr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) + qqs(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqns(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -!gfdlmp - endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif ! for MG3 MP ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) + cfr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) + ref_10cm(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2262,12 +2313,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) + q2(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2275,8 +2326,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif -! end loop ncount_field - enddo + enddo ! end loop ncount_field if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2302,46 +2352,33 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - end do - end do + pd(i,j) = spval + enddo + enddo do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) !compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) enddo enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2349,22 +2386,23 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2390,13 +2428,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp - if( imp_physics == 11 ) then +! compute cwm for gfdlmp or MG3 + if( imp_physics == 10 .or. imp_physics == 11) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) enddo enddo enddo @@ -2406,8 +2444,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2418,13 +2456,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l + htop(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! hbot do j=jsta,jend From 86220446409d3ec3b2f77c7b853f48376bbead6b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 9 Sep 2020 00:21:30 +0000 Subject: [PATCH 087/217] adding a new suite --- .../suites/suite_FV3_GFS_2017_couplednsst.xml | 89 +++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml new file mode 100644 index 000000000..241b8cc0c --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml @@ -0,0 +1,89 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + zhaocarr_gscond + zhaocarr_precpd + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + From 540273975921bb814a0ef8c7f4a64ebbff6437a6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 10 Sep 2020 21:24:27 -0400 Subject: [PATCH 088/217] updating .gitmodules and some fix in FV3GFS_io --- .gitmodules | 8 +-- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- .../suites/suite_FV3_GFS_2017_couplednsst.xml | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 72 ++++++++++--------- io/FV3GFS_io.F90 | 2 +- 6 files changed, 48 insertions(+), 40 deletions(-) diff --git a/.gitmodules b/.gitmodules index d253f6966..1feca5aca 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,12 +1,12 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-EMC/GFDL_atmos_cubed_sphere - branch = dev/emc + url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere + branch = SM_Aug272020 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework branch = master [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics - branch = master + url = https://github.com/SMoorthi-emc/ccpp-physics + branch = SM_Sep09092020 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 8b59ebc03..7be41cc1e 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 8b59ebc039dafe1c20ed6dd21cb38ca564852b98 +Subproject commit 7be41cc1e49428c808741dd1f1aaf3f931b41fed diff --git a/ccpp/physics b/ccpp/physics index 0808cc2e8..736f8f677 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0808cc2e8938ba66003b46746858143a9d75addb +Subproject commit 736f8f67701733926d7b653121772caf5d797adb diff --git a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml index 241b8cc0c..1aa7ca484 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml @@ -1,6 +1,6 @@ - + diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 8c2273f2c..62b48b872 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -814,8 +814,8 @@ subroutine GFS_physics_driver & ! do i=1,im ! lprnt = Model%me == 23 .and. i == 25 ! lprnt = Model%me == 127 .and. i == 11 -! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-102.65) < 0.101 & -! .and. abs(grid%xlat(i)*rad2dg-0.12) < 0.201 +! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-295.40) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-47.0) < 0.101 ! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 & ! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301 ! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 & @@ -2183,17 +2183,17 @@ subroutine GFS_physics_driver & endif if (islmsk(i) == 1) then k = 1 - Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land stress(i) = stress3(i,1) ! Sfcprop%tprcp(i) = tprcp3(i,1) + Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land Sfcprop%tsfco(i) = tsfc3(i,1) Sfcprop%tisfc(i) = tsfc3(i,1) Sfcprop%tsfc(i) = tsfc3(i,1) elseif (islmsk(i) == 0) then k = 3 - Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled) stress(i) = stress3(i,3) ! Sfcprop%tprcp(i) = tprcp3(i,3) + Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled) Sfcprop%tisfc(i) = tsfc3(i,3) Sfcprop%tsfcl(i) = tsfc3(i,3) Sfcprop%tsfc(i) = tsfc3(i,3) @@ -2201,6 +2201,7 @@ subroutine GFS_physics_driver & k = 2 stress(i) = stress3(i,2) ! Sfcprop%tprcp(i) = fice(i)*tprcp3(i,2) + (one-fice(i))*tprcp3(i,3) + Sfcprop%tsfc(i) = tsfc3(i,2) endif Sfcprop%zorl(i) = zorl3(i,k) cd(i) = cd3(i,k) @@ -2227,37 +2228,43 @@ subroutine GFS_physics_driver & Sfcprop%zorli(i) = zorl3(i,2) Sfcprop%zorlo(i) = zorl3(i,3) - if (flag_cice(i)) then - if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice - txi = fice(i) - txo = one - txi - evap(i) = txi * evap3(i,2) + txo * evap3(i,3) - hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) - Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) - stress(i) = txi *stress3(i,2) + txo * stress3(i,3) - qss(i) = txi * qss3(i,2) + txo * qss3(i,3) - ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) - Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + if (k == 2) then + if (wet(i)) then + Sfcprop%tsfco(i) = tsfc3(i,3) + endif + if (flag_cice(i)) then + if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice + txi = fice(i) + txo = one - txi + evap(i) = txi * evap3(i,2) + txo * evap3(i,3) + hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) + Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) + stress(i) = txi *stress3(i,2) + txo * stress3(i,3) + qss(i) = txi * qss3(i,2) + txo * qss3(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) + Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + endif + elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + Sfcprop%tsfc(i) = tsfc3(i,2) + Sfcprop%hice(i) = zice(i) + Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen + Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3) + else ! this would be over open ocean or land (no ice fraction) + Sfcprop%hice(i) = zero + Sfcprop%fice(i) = zero + Sfcprop%tsfc(i) = Sfcprop%tsfco(i) + Sfcprop%tisfc(i) = Sfcprop%tsfc(i) + icy(i) = .false. + endif + Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + if (.not. wet(i)) then + Sfcprop%tsfco(i) =Sfcprop%tsfc(i) endif - elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array - Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) - Sfcprop%hice(i) = zice(i) - Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen - Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3) - else ! this would be over open ocean or land (no ice fraction) - Sfcprop%hice(i) = zero - Sfcprop%fice(i) = zero - Sfcprop%tisfc(i) = Sfcprop%tsfc(i) - icy(i) = .false. - endif - Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) - if (wet(i)) then - Sfcprop%tsfco(i) = tsfc3(i,3) - else - Sfcprop%tsfco(i) =Sfcprop%tsfc(i) endif do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case - Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) +! Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) + Sfcprop%stc(i,k) = stsoil(i,k) enddo enddo endif ! if (Model%frac_grid) @@ -5808,6 +5815,7 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' end driver sfcprop%tsfcl=',Sfcprop%tsfcl(ipr),' kdt=',kdt ! if (lprnt) write(0,*)' end driver sfcprop%tsfco=',Sfcprop%tsfco(ipr),' kdt=',kdt ! if (lprnt) write(0,*)' end driver sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tsfc=',Sfcprop%tsfc(ipr),' kdt=',kdt,wet(ipr),icy(ipr),dry(ipr) ! endif return diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 329eac5ec..458605c96 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1357,7 +1357,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo else - if (Model%kdt <= 0) then + if( Model%phour < 1.e-7) then !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) From 7e2cfe822c61854065f70a9e91eec81a03559b74 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Sep 2020 00:06:12 +0000 Subject: [PATCH 089/217] after gitmoduel sync --- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 7be41cc1e..a976dba87 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 7be41cc1e49428c808741dd1f1aaf3f931b41fed +Subproject commit a976dba8761821a3b085e057de926543da5a6833 diff --git a/ccpp/physics b/ccpp/physics index 736f8f677..28cf65480 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 736f8f67701733926d7b653121772caf5d797adb +Subproject commit 28cf654806dd1ec6d8ff88386a80a2e683002f3b From 6390ec7c128ee4b5b44f8efaee5a978392164b51 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 24 Sep 2020 20:56:23 -0400 Subject: [PATCH 090/217] after syncing submodules --- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 7be41cc1e..32a406a13 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 7be41cc1e49428c808741dd1f1aaf3f931b41fed +Subproject commit 32a406a13283337358aeef33685176ad43f9fb01 diff --git a/ccpp/physics b/ccpp/physics index 736f8f677..28cf65480 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 736f8f67701733926d7b653121772caf5d797adb +Subproject commit 28cf654806dd1ec6d8ff88386a80a2e683002f3b From 4024b7e2d18f49b462709e1e9c192b20724a5591 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 14 Oct 2020 00:16:20 +0000 Subject: [PATCH 091/217] updating submodules --- atmos_cubed_sphere | 2 +- ccpp/framework | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index f73c1dadb..29ccfd4a0 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit f73c1dadb868ef0816f11a207ed621767bff798d +Subproject commit 29ccfd4a02cc22498c8eefc189e9dd2859f0ba40 diff --git a/ccpp/framework b/ccpp/framework index f037de7d9..dca1240e6 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit f037de7d991b34c49c5cacb6515209c7ca285054 +Subproject commit dca1240e6f19a5bbcfa0b14aa8526f36e99ed135 From 11e459bc06d2dd17ddc5c7bf5348abecaaa0d755 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 26 Oct 2020 21:14:29 -0400 Subject: [PATCH 092/217] updates to IPD --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 3 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 82 ++++++++++++--------- gfsphysics/GFS_layer/GFS_typedefs.F90 | 4 +- gfsphysics/physics/sfc_sice.f | 14 +++- 6 files changed, 62 insertions(+), 45 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 29ccfd4a0..620941b7d 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 29ccfd4a02cc22498c8eefc189e9dd2859f0ba40 +Subproject commit 620941b7dd01c6fccab5cb00f5955216f681f30f diff --git a/atmos_model.F90 b/atmos_model.F90 index 860079949..ff6d67758 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1761,7 +1761,6 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - IPD_Data(nb)%Sfcprop%fice(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = IPD_Data(nb)%Sfcprop%slmsk(ix) ofrac = IPD_Data(nb)%Sfcprop%oceanfrac(ix) if (ofrac > zero) then @@ -1776,7 +1775,7 @@ subroutine assign_importdata(rc) if (abs(one-ofrac) < epsln) then IPD_Data(nb)%Sfcprop%slmsk(ix) = zero IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero - end if + endif endif endif enddo diff --git a/ccpp/physics b/ccpp/physics index 1aaa5b369..d004773c0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1aaa5b36964010aec10a32e2ce23c9c9084a0182 +Subproject commit d004773c06f81b27f429358cf3c63b7549a42471 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 62b48b872..dcbfcd150 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1121,33 +1121,38 @@ subroutine GFS_physics_driver & frland(i) = Sfcprop%landfrac(i) if (frland(i) > zero) dry(i) = .true. if (frland(i) < one) then - if (flag_cice(i)) then + if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. - if (fice(i) < one) wet(i) = .true. ! some open ocean/lake water exists + tice(i) = min(Sfcprop%tisfc(i), tgice) + if (Model%cplflx) then + islmsk_cice(i) = 4 + flag_cice(i) = .true. + endif + islmsk(i) = 2 else fice(i) = zero flag_cice(i) = .false. islmsk_cice(i) = 0 -! islmsk(i) = 0 - wet(i) = .true. ! some open ocean/lake water exists + islmsk(i) = 0 + endif + if (fice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. Model%cplflx .and. icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif else if (fice(i) >= Model%min_lakeice) then icy(i) = .true. - if (fice(i) < one) wet(i) = .true. ! some open ocean/lake water exists islmsk(i) = 2 + tice(i) = min(Sfcprop%tisfc(i), tgice) else fice(i) = zero -! islmsk(i) = 0 - wet(i) = .true. ! some open ocean/lake water exists + islmsk(i) = 0 endif - endif - if (wet(i) .and. .not. Model%cplflx) then - if (Sfcprop%oceanfrac(i) > zero) then - Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) - elseif (icy(i)) then - Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) +! islmsk_cice(i) = islmsk(i) + if (fice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif endif else @@ -1163,7 +1168,7 @@ subroutine GFS_physics_driver & fice(i) = zero else frland(i) = zero - if (flag_cice(i)) then + if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) > Model%min_seaice) then icy(i) = .true. else @@ -1172,6 +1177,10 @@ subroutine GFS_physics_driver & islmsk_cice(i) = 0 islmsk(i) = 0 endif + if (fice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. Model%cplflx .and. icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif else if (fice(i) > Model%min_lakeice) then icy(i) = .true. @@ -1179,11 +1188,10 @@ subroutine GFS_physics_driver & fice(i) = zero islmsk(i) = 0 endif - endif - if (fice(i) < one) then - wet(i)=.true. ! some open ocean/lake water exists - if (.not. Model%cplflx .and. icy(i)) & - Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + if (fice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif endif endif enddo @@ -1269,6 +1277,7 @@ subroutine GFS_physics_driver & gflx3(i,2) = zero semis3(i,2) = 0.95_kind_phys endif + if (nint(Sfcprop%slmsk(i)) /= 1) Sfcprop%slmsk(i) = islmsk(i) enddo !*## CCPP ## @@ -1993,21 +2002,23 @@ subroutine GFS_physics_driver & ! ! call sfc_sice for lake ice and for the uncoupled case, sea ice (i.e. islmsk=2) ! - if (Model%frac_grid) then - do i=1,im - if (icy(i) .and. islmsk(i) < 2) then - if (Sfcprop%oceanfrac(i) > zero) then - tem = Model%min_seaice - else - tem = Model%min_lakeice - endif - if (fice(i) > tem) then - islmsk(i) = 2 - tsfc3(i,2) = Sfcprop%tisfc(i) - endif - endif - enddo - endif +! if (Model%frac_grid) then +! do i=1,im +! if (icy(i) .and. islmsk(i) < 2) then +! if (Sfcprop%oceanfrac(i) > zero) then +! if (fice(i) >= Model%min_seaice) then +! islmsk(i) = 4 +! tice(i) = min(Sfcprop%tisfc(i), tgice) +! endif +! else +! if (fice(i) >= Model%min_lakeice) then +! islmsk(i) = 2 +! tice(i) = min(Sfcprop%tisfc(i), tgice) +! endif +! endif +! endif +! enddo +! endif !## CCPP ##* sfc_sice.f/sfc_sice_run call sfc_sice & ! --- inputs: @@ -2017,7 +2028,8 @@ subroutine GFS_physics_driver & gabsbdlw3(:,2), adjsfcnsw, adjsfcdsw, Sfcprop%srflag, & cd3(:,2), cdq3(:,2), & Statein%prsl(:,1), work3, islmsk, wind, & - flag_iter, lprnt, ipr, Model%min_lakeice, & + flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & + Sfcprop%oceanfrac, & ! --- input/output: zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & stsoil, ep1d3(:,2), & diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 043ee1f83..b3e63c794 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1101,7 +1101,7 @@ module GFS_typedefs integer :: nreffr !< the index of rain effective radius in phy_f3d integer :: nseffr !< the index of snow effective radius in phy_f3d integer :: ngeffr !< the index of graupel effective radius in phy_f3d -#ifdef CCPP +!#ifdef CCPP integer :: nkbfshoc !< the index of upward kinematic buoyancy flux from SHOC in phy_f3d integer :: nahdshoc !< the index of diffusivity for heat from from SHOC in phy_f3d integer :: nscfshoc !< the index of subgrid-scale cloud fraction from from SHOC in phy_f3d @@ -1111,7 +1111,7 @@ module GFS_typedefs integer :: nqvdelt !< the index of specific humidity at the previous timestep for Z-C MP in phy_f3d integer :: nps2delt !< the index of surface air pressure 2 timesteps back for Z-C MP in phy_f2d integer :: npsdelt !< the index of surface air pressure at the previous timestep for Z-C MP in phy_f2d -#endif +!#endif !--- debug flag logical :: debug diff --git a/gfsphysics/physics/sfc_sice.f b/gfsphysics/physics/sfc_sice.f index c3680aa93..bf66ef23a 100644 --- a/gfsphysics/physics/sfc_sice.f +++ b/gfsphysics/physics/sfc_sice.f @@ -35,7 +35,7 @@ subroutine sfc_sice & ! & ( im, km, ps, u1, v1, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, islimsk, wind, & - & flag_iter, lprnt, ipr, cimin, & + & flag_iter, lprnt, ipr, min_lakeice, min_seaice, oceanfrac, & ! --- input/outputs: & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & ! --- outputs: @@ -144,10 +144,11 @@ subroutine sfc_sice & real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & - & prsl1, prslki, wind + & prsl1, prslki, wind, oceanfrac integer, dimension(im), intent(in) :: islimsk - real (kind=kind_phys), intent(in) :: delt, cimin + real (kind=kind_phys), intent(in) :: delt, min_lakeice, & + & min_seaice logical, intent(in) :: flag_iter(im) @@ -169,7 +170,7 @@ subroutine sfc_sice & & snowd, theta1 real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) - &, hflxi, hflxw, q0, qs1, qssi, qssw + &, hflxi, hflxw, q0, qs1, qssi, qssw, cimin integer :: i, k @@ -215,6 +216,11 @@ subroutine sfc_sice & do i = 1, im if (flag(i)) then + if (oceanfrac(i) > zero) then + cimin = min_seaice + else + cimin = min_lakeice + endif ! psurf(i) = 1000.0 * ps(i) ! ps1(i) = 1000.0 * prsl1(i) From 8580585d175bf37d82d68f5244048b266a89bd2a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 27 Oct 2020 14:01:43 -0400 Subject: [PATCH 093/217] some minor update in physics driver --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index d004773c0..de54bb476 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d004773c06f81b27f429358cf3c63b7549a42471 +Subproject commit de54bb47609fc32785e6ecc65053545f11dc8c4e diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index dcbfcd150..f0e9f3ed1 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1070,7 +1070,8 @@ subroutine GFS_physics_driver & fice(i) = Sfcprop%fice(i) !*## CCPP ##* !## CCPP ##* GFS_surface_composites.F90/GFS_surface_composites_pre_run - tice(i) = Sfcprop%tisfc(i) +! tice(i) = Sfcprop%tisfc(i) + tice(i) = zero ! !GFDL work1(i) = (log(coslat(i) / (nlons(i)*latr)) - dxmin) * dxinv !GFS Moorthi thinks this should be area and not dx @@ -1124,7 +1125,7 @@ subroutine GFS_physics_driver & if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. - tice(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) if (Model%cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -1144,7 +1145,7 @@ subroutine GFS_physics_driver & if (fice(i) >= Model%min_lakeice) then icy(i) = .true. islmsk(i) = 2 - tice(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) else fice(i) = zero islmsk(i) = 0 @@ -1169,7 +1170,7 @@ subroutine GFS_physics_driver & else frland(i) = zero if (Sfcprop%oceanfrac(i) > zero) then - if (fice(i) > Model%min_seaice) then + if (fice(i) >= Model%min_seaice) then icy(i) = .true. else fice(i) = zero @@ -1182,7 +1183,7 @@ subroutine GFS_physics_driver & if (.not. Model%cplflx .and. icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif else - if (fice(i) > Model%min_lakeice) then + if (fice(i) >= Model%min_lakeice) then icy(i) = .true. else fice(i) = zero @@ -1272,6 +1273,7 @@ subroutine GFS_physics_driver & zorl3(i,2) = Sfcprop%zorli(i) tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) + tice(i) = Sfcprop%tisfc(i) snowd3(i,2) = Sfcprop%snowd(i) ep1d3(i,2) = zero gflx3(i,2) = zero From 24b7647e933ed4fdd77cf4d9cf84d4731dd09471 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 27 Oct 2020 20:53:50 -0400 Subject: [PATCH 094/217] adding a clean phys driver --- .../GFS_layer/GFS_physics_driver.F90_clean | 5691 +++++++++++++++++ 1 file changed, 5691 insertions(+) create mode 100644 gfsphysics/GFS_layer/GFS_physics_driver.F90_clean diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean new file mode 100644 index 000000000..66c1e282b --- /dev/null +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -0,0 +1,5691 @@ +module module_physics_driver + + use machine, only: kind_phys + use physcons, only: con_cp, con_fvirt, con_g, con_rd, & + con_rv, con_hvap, con_hfus, & + con_rerth, con_pi, rhc_max, dxmin, & + dxinv, pa2mb, rlapse, con_eps, & + con_epsm1, PQ0, A2A, A3, A4, RHmin, & + tgice => con_tice + + use cs_conv, only: cs_convr + use ozne_def, only: levozp, oz_coeff, oz_pres + use h2o_def, only: levh2o, h2o_coeff, h2o_pres + use gfs_fv3_needs, only: get_prs_fv3, get_phi_fv3 + use module_nst_water_prop, only: get_dtzm_2d + use GFS_typedefs, only: GFS_statein_type, GFS_stateout_type, & + GFS_sfcprop_type, GFS_coupling_type, & + GFS_control_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & +! GFS_radtend_type, GFS_diag_type + GFS_radtend_type, GFS_diag_type, huge + use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_driver, & + cloud_diagnosis + use module_mp_thompson, only: mp_gt_driver + use module_mp_wsm6, only: wsm6 + use funcphys, only: ftdp + use surface_perturbation, only: cdfnor + + use module_sfc_diff, only: sfc_diff + use module_sfc_ocean, only: sfc_ocean + use module_sfc_drv, only: sfc_drv + use module_sfc_sice, only: sfc_sice + use module_sfc_cice, only: sfc_cice + use module_sfc_nst, only: sfc_nst + use module_sfc_diag, only: sfc_diag +! +!vay-2018 +! + use cires_ugwp_module, only: cires_ugwp_driver, knob_ugwp_version +! + + implicit none + + + !--- CONSTANT PARAMETERS + real(kind=kind_phys), parameter :: hocp = con_hvap/con_cp + real(kind=kind_phys), parameter :: epsln = 1.0e-10_kind_phys + real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys + real(kind=kind_phys), parameter :: qsmall = 1.0e-20_kind_phys + real(kind=kind_phys), parameter :: rainmin = 1.0e-13_kind_phys + real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys + real(kind=kind_phys), parameter :: epsq = 1.0e-20_kind_phys + real(kind=kind_phys), parameter :: hsub = con_hvap+con_hfus + real(kind=kind_phys), parameter :: czmin = 0.0001_kind_phys ! cos(89.994) + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, & + half = 0.5_kind_phys, onebg = one/con_g + real(kind=kind_phys), parameter :: albdf = 0.06_kind_phys + real(kind=kind_phys), parameter :: tf=258.16_kind_phys, tcr=273.16_kind_phys, tcrf=one/(tcr-tf) + real(kind=kind_phys), parameter :: con_p001= 0.001_kind_phys + real(kind=kind_phys), parameter :: con_day = 86400.0_kind_phys + real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi + real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys +! real(kind=kind_phys), parameter :: huge = 0.0_kind_phys + +!> GFS Physics Implementation Layer +!> @brief Layer that invokes individual GFS physics routines +!> @{ +!at tune step===========================================================! +! description: ! +! ! +! usage: ! +! ! +! call GFS_physics_driver ! +! ! +! --- interface variables ! +! type(GFS_control_type), intent(in) :: Model ! +! type(GFS_statein_type), intent(inout) :: Statein ! +! type(GFS_stateout_type), intent(inout) :: Stateout ! +! type(GFS_sfcprop_type), intent(inout) :: Sfcprop ! +! type(GFS_coupling_type), intent(inout) :: Coupling ! +! type(GFS_grid_type), intent(in) :: Grid ! +! type(GFS_tbd_type), intent(inout :: Tbd ! +! type(GFS_cldprop_type), intent(inout) :: Cldprop ! +! type(GFS_radtend_type), intent(inout) :: Radtend ! +! type(GFS_diag_type), intent(inout) :: Diag ! +! ! +! subprograms called: ! +! ! +! get_prs, dcyc2t2_pre_rad (testing), dcyc2t3, sfc_diff, ! +! sfc_ocean,sfc_drv, sfc_sice, sfc_cice, sfc_diag, moninp1, ! +! moninp, moninq1, moninq, satmedmfvdif, ! +! gwdps, ozphys, get_phi, ! +! sascnv, sascnvn, samfdeepcnv, rascnv, cs_convr, gwdc, ! +! shalcvt3, shalcv, samfshalcnv, ! +! shalcnv, cnvc90, lrgscl, gsmdrive, gscond, precpd, ! +! progt2. ! +! ! +! ! +! program history log: ! +! 19xx - ncep mrf/gfs ! +! 2002 - s. moorthi modify and restructure and add Ferrier ! +! microphysics as an option ! +! 200x - h. juang modify (what?) ! +! nov 2004 - x. wu modify sea-ice model ! +! may 2005 - s. moorthi modify and restructure ! +! 2005 - s. lu modify to include noah lsm ! +! oct 2006 - h. wei modify lsm options to include both ! +! noah and osu lsms. ! +! 2006 - s. moorthi added a. johansson's convective gravity ! +! wave parameterization code ! +! 2007 - s. moorthi added j. han's modified pbl/sas options ! +! dec 2007 - xu li modified the operational version for ! +! nst model ! +! 2008 - s. moorthi applied xu li's nst model to new gfs ! +! mar 2008 - y.-t. hou added sunshine duration var (suntim) as ! +! an input/output argument. ! +! 2008 - jun wang added spfhmax/spfhmin as input/output. ! +! apr 2008 - y.-t. hou added lw sfc emissivity var (sfcemis), ! +! define the lw sfc dn/up fluxes in two forms: atmos! +! and ground. also changed sw sfc net flux direction! +! (positive) from ground -> atmos to the direction ! +! of atmos -> ground. recode the program and add ! +! program documentation block. +! 2008/ - s. moorthi and y.t. hou upgraded the code to more ! +! 2009 modern form and changed all the inputs to MKS units.! +! feb 2009 - s. moorthi upgraded to add Hochun's gocart changes ! +! jul 2009 - s. moorthi added rqtk for sela's semi-lagrangian ! +! aug 2009 - s. moorthi added j. han and h. pan updated shallow ! +! convection package ! +! sep 2009 - s. moorthi updated for the mcica (rrtm3) radiation ! +! feb 2011 - sarah lu add the option to update surface diag ! +! fields (t2m,q2m,u10m,v10m) at the end ! +! Jun 2011 - s. moorthi and Xu Li - updated the nst model ! +! ! +! sep 2011 - sarah lu correct dqdt_v calculations ! +! apr 2012 - henry juang add idea ! +! sep 2012 - s. moorthi merge with operational version ! +! Mar 2013 - Jun Wang set idea heating rate to tmp tendency ! +! May 2013 - Jun Wang tmp updated after idea phys ! +! Jun 2013 - s. moorthi corrected a bug in 3d diagnostics for T ! +! Aug 2013 - s. moorthi updating J. Whitekar's changes related ! +! to stochastic physics perturnbation ! +! Oct 2013 - Xingren Wu add dusfci/dvsfci ! +! Mar 2014 - Xingren Wu add "_cpl" for coupling ! +! Mar 2014 - Xingren Wu add "nir/vis beam and nir/vis diff" ! +! Apr 2014 - Xingren Wu add "NET LW/SW including nir/vis" ! +! Jan 2014 - Jun Wang merge Moorthi's gwdc change and H.Juang ! +! and F. Yang's energy conversion from GWD! +! jan 2014 - y-t hou revised sw sfc spectral component fluxes! +! for coupled mdl, added estimation of ocean albedo ! +! without ice contamination. ! +! Jun 2014 - Xingren Wu update net SW fluxes over the ocean ! +! (no ice contamination) ! +! Jul 2014 - Xingren Wu add Sea/Land/Ice Mask - slmsk_cpl ! +! Jul 2014 - s. moorthi merge with standalone gfs and cleanup ! +! Aug 2014 - s. moorthi add tracer fixer ! +! Sep 2014 - Sarah Lu disable the option to compute tracer ! +! scavenging in GFS phys (set fscav=0.) ! +! Dec 2014 - Jun Wang add cnvqc_v for gocart ! + +! ==================== defination of variables ==================== ! +! --- 2014 - D. Dazlich Added Chikira-Sugiyama (CS) convection ! +! as an option in opr GFS. ! +! Apr 2015 S. Moorthi Added CS scheme to NEMS/GSM ! +! Jun 2015 S. Moorthi Added SHOC to NEMS/GSM ! +! Aug 2015 - Xu Li change nst_fcst to be nstf_name ! +! and introduce depth mean SST ! +! Sep 2015 - Xingren Wu remove oro_cpl & slmsk_cpl ! +! Sep 2015 - Xingren Wu add sfc_cice ! +! Sep 2015 - Xingren Wu connect CICE output to sfc_cice ! +! Jan 2016 - P. Tripp NUOPC/GSM merge ! +! Mar 2016 - J. Han - add ncnvcld3d integer ! +! for convective cloudiness enhancement ! +! Mar 2016 - J. Han - change newsas & sashal to imfdeepcnv ! +! & imfshalcnv, respectively ! +! Mar 2016 F. Yang add pgr to rayleigh damping call ! +! Mar 2016 S. Moorthi add ral_ts ! +! Mar 2016 Ann Cheng add morrison 2m microphysics (gsfc) ! +! May 2016 S. Moorthi cleanup 2m microphysics implementation ! +! Jun 2016 X. Li change all nst_fld as inout ! +! jul 2016 S. Moorthi fix some bugs in shoc/2m microphysics ! +! au-nv2016a S. Moorthi CS with AW and connect with shoc/2m ! +! Dec 2016 Anning C. Add prognostic rain and snow with 2M ! +! Oct 2017 S. Moorthi fix tracers to account for ice, snow etc! +! with this RAS and CSAW advect condensates! +! Mar 2017 Ruiyu S. Add Thompson's 2M aerosol MP ! +! May 2017 Ruiyu S. Add WSM6 MP ! +! Dec 2017 S. Moorthi Merge/update Ruiyu's update on vertical ! +! diffusion of tracers for all monins ! +! Jan 04 2018 S. Moorthi fix a bug in rhc for use in MG ! +! macrophysics and replace ntrac by nvdiff! +! in call to moninshoc ! +! Jun 2018 J. Han Add scal-aware TKE-based moist EDMF ! +! vertical turbulent mixng scheme ! +! Nov 2018 J. Han Add canopy heat storage parameterization! +! Feb 2019 Ruiyu S. Add an alternate method to use ! +! hydrometeors from GFDL MP in radiation ! +! Mar 2019 Rongqian &Helin Add Noah MP LSM ! +! Mar 2019 S. Moorthi update slflag for MG3 and update ! +! rain/snow over sea-ice. Update sfc_sice! +! sfc_cice calls ! +! +! Apr 22 2019 S. Moorthi Porting Unified Gravitiy Wave drag ! +! parameterrizaion package from V. Yudin, ! +! J. Alpert, T. Fuller-Rowll and R. Akmaev! +! May 2019 J. Han Add updated scal-aware TKE-based moist ! +! EDMF vertical turbulent mixng scheme ! +! july 2019 S. Moorthi Move original GWD to inside of UGW such ! +! that it can be called along with non- ! +! stationary GWD and make this part a ! +! function of precip or TKE. ! +! Jul 2019 Weiguo Wang Update PBL scheme for HAFS ! +! +! ==================== end of description ===================== +! ==================== definition of variables ==================== ! + +!> @details This subroutine is the suite driver for the GFS atmospheric physics and surface. +!! It is responsible for calculating and applying tendencies of the atmospheric state +!! variables due to the atmospheric physics and due to the surface layer scheme. In addition, +!! this routine applies radiative heating rates that were calculated during the +!! antecedent call to the radiation scheme. Code within this subroutine is executed on the +!! physics sub-timestep. The sub-timestep loop is executed in the subroutine gloopb. +!! +!! \section general General Algorithm +!! -# Prepare input variables for calling individual parameterizations. +!! -# Using a two-iteration loop, calculate the state variable tendencies for the surface layer. +!! -# Calculate the state variable tendencies due to the PBL (vertical diffusion) scheme. +!! -# Calculate the state variable tendencies due to orographic gravity wave drag and Rayleigh damping. +!! -# Apply tendencies to the state variables calculated so far: +!! - for temperature: radiation, surface, PBL, oro. GWD, Rayleigh damping +!! - for momentum: surface, PBL, oro. GWD, Rayleigh damping +!! - for water vapor: surface, PBL +!! -# Calculate and apply the tendency of ozone. +!! -# Prepare input variables for physics routines that update the state variables within their subroutines. +!! -# If SHOC is active and is supposed to be called before convection, call it and update the state variables within. +!! -# Calculate and apply the state variable tendencies (within the subroutine) due to deep convection. +!! -# Calculate the state variable tendencies due to convective gravity wave drag and apply them afterwards. +!! -# Calculate and apply the state variable tendencies (within the subroutine) due to shallow convection. +!! -# If SHOC is active and is supposed to be called after convection, call it and update the state variables within. +!! -# Prepare for microphysics call by calculating preliminary variables. +!! -# If necessary, call the moist convective adjustment subroutine and update the state temperature and moisture variable within. +!! -# Calculate and apply the state variable tendencies (within the subroutine) due to microphysics. +!! -# Determine the precipitation type and update land surface properties if necessary. +!! -# Fill the output variables from the local variables as necessary and deallocate allocatable arrays. +!! \section detailed Detailed Algorithm +!! ## Prepare input variables for calling individual parameterizations. +!! Before calling any parameterizations, there is a section at the beginning of the subroutine for +!! preparing input arguments to the various schemes based on general input to the driver and initializing +!! variables used throughout the driver. +!! - General initialization: +!! - set a flag for running in debug mode and the horizontal index of the column to print +!! - calculate the pressure at layer centers, the exner function at layer centers and interfaces, +!! geopotential at layer centers and interfaces, and the layer-centered pressure difference +!! - calculate the ratio of dynamics time step to physics time step for applying tendencies +!! - initialize local tendency arrays to zero +!! - Radiation: +!! - adjust radiative fluxes and heating rates to the shorter physics time step (from the longer radiation time step), +!! unless idealized physics is true (lsidea) where radiative heating rates are set to 0 +!! - compute diagnostics from the radiation scheme needed for other schemes (e.g., downward longwave flux absorbed by the surface) +!! - accumulate the upward and downward longwave fluxes at the surface +!! - Surface: +!! - set NOAH and OSU scheme variables from gbphys input arguments and initialize local soil moisture variables +!! - set local sea ice variables from gbphys arguments +!! - set up A/O/I coupling variables from gbphys arguments +!! - PBL: +!! - set the number of tracers that are diffused vertically +!! - SHOC: +!! - determine the index of TKE (ntk) in the convectively transported tracer array (clw) +!! - allocate precipitation mixing ratio cloud droplet number concentration arrays +!! - Deep Convection: +!! - determine which tracers in the tracer input array undergo convective transport (valid for the RAS and Chikira-Sugiyama, and SAMF schemes) and allocate a local convective transported tracer array (clw) +!! - apply an adjustment to the tracers from the dynamics +!! - calculate horizontal grid-related parameters needed for some parameterizations +!! - calculate the maxiumum cloud base updraft speed for the Chikira-Sugiyama scheme +!! - allocate array for cloud water and cloud cover (for non-RAS and non-Chikira-Sugiyama deep convective schemes) +!! - Shallow Convection: +!! - when using the Tiedtke shallow convection scheme with the stratus modifications, find the lowest +!! model level where a temperature inversion exists in the absence of CTEI +!! - Microphysics: +!! - for the Morrison (MGB) scheme, calculate 'FRLAND' if the grid point is over land +!! - allocate arrays associated with the Morrison scheme +!! - assign the local critical relative humidity variables from the gbphys arguments +!! - Gravity Wave Drag: +!! - calculate the deep convective cloud fraction at cloud top for the convective GWD scheme +!! . +!! ## Using a two-iteration loop, calculate the state variable tendencies for the surface layer. +!! - Each iteration of the loop calls the following: +!! - 'sfc_diff' to calculate surface exchange coefficients and near-surface wind +!! - surface energy balances routines are called regardless of surface type; the surface type is checked within each to determine whether the routine is "active" +!! - for the surface energy balance over the ocean, call 'sfc_nst' if NSST is on, otherwise, call 'sfc_ocean' +!! - for the surface energy balance over the land, call 'sfc_drv' for the NOAH model and 'sfc_land' for the OSU model +!! - for the surface energy balance over sea ice, call sfc_sice; if A/O/I coupling, call sfc_cice +!! - The initial iteration has flag_guess = F unless wind < 2 m/s; flag_iter = T +!! - After the initial iteration, flag_guess = F and flag_iter = F (unless wind < 2 m/s and over a land surface or an ocean surface with NSST on) +!! - The following actions are performed after the iteration to calculate surface energy balance: +!! - set surface output variables from their local values +!! - call 'sfc_diag' to calculate state variable values at 2 and 10 m as appropriate from near-surface model levels and the surface exchange coefficients +!! - if A/O/I coupling, set coupling variables from local variables and calculate the open water albedo +!! - finally, accumulate surface-related diagnostics and calculate the max/min values of T and q at 2 m height. +!! . +!! ## Calculate the state variable tendencies due to the PBL (vertical diffusion) scheme. +!! - Call the vertical diffusion scheme (PBL) based on the following logical flags: do_shoc, hybedmf, satmedmf, old_monin, mstrat +!! - the PBL scheme is expected to return tendencies of the state variables +!! - If A/O/I coupling and the surface is sea ice, overwrite some surface-related variables to their states before PBL was called +!! - For diagnostics, do the following: +!! - accumulate surface state variable tendencies and set the instantaneous values for output +!! - accumulate the temperature tendency due to the PBL scheme in dt3dt(:,:,3), subtracting out the radiative heating rate if necessary +!! - accumulate the u, v tendencies due to the PBL in du3dt(:,:,1:2) and dv3dt(:,:,1:2) +!! - accumulate the water vapor tendency due to the PBL in dq3dt(:,:,1) +!! - accumulate the ozone tendency in dq3dt(:,:,5) +!! . +!! ## Calculate the state variable tendencies due to orographic gravity wave drag and Rayleigh damping. +!! - Based on the variable nmtvr, unpack orographic gravity wave varibles from the hprime array +!! - Call 'gwdps' to calculate tendencies of u, v, T, and surface stress +!! - Accumulate gravity wave drag surface stresses. +!! - Accumulate change in u, v, and T due to oro. gravity wave drag in du3dt(:,:,2), dv3dt(:,:,2), and dt3dt(:,:,2) +!! - Call 'rayleigh_damp' to calculate tendencies to u, v, and T due to Rayleigh friction +!! . +!! ## Apply tendencies to the state variables calculated so far. +!! ## Calculate and apply the tendency of ozone. +!! - Call the convective adjustment scheme for IDEA +!! - Call 'ozphys_2015' or 'ozphys' depending on the value of pl_coeff, updating the ozone tracer within and outputing the tendency of ozone in dq3dt(:,:,6) +!! - Call 'h2ophys' if necessary ("adaptation of NRL H2O phys for stratosphere and mesophere") +!! . +!! ## Prepare input variables for physics routines that update the state variables within their subroutines. +!! - If diagnostics is active, save the updated values of the state variables in 'dudt', 'dvdt', 'dTdt', and 'dqdt(:,:,1)' +!! - Call 'get_phi' to calculate geopotential from p, q, T +!! - Initialize the cloud water and ice portions of the convectively transported tracer array (clw) and (if the deep convective scheme is not RAS or Chikira-Sugiyama) the convective cloud water and cloud cover. +!! - If the dep convective scheme is RAS or Chikira-Sugiyama, fill the 'clw' array with tracers to be transported by convection +!! - Initialize 'ktop' and 'kbot' (to be modified by all convective schemes except Chikira-Sugiyama) +!! - Prepare for microphysics call (if cloud condensate is in the input tracer array): +!! - all schemes: calculate critical relative humidity +!! - Morrison et al. scheme (occasionally denoted MGB) (when ncld==2): set clw(:,:,1) to cloud ice and clw(:,:,2) to cloud liquid water +!! - Ferrier scheme (num_p3d==3): set the cloud water variable and separate hydrometeors into cloud ice, cloud water, and rain; set clw(:,:,1) to cloud ice and clw(:,:,2) to cloud liquid water +!! - Zhao-Carr scheme (num_p3d==4): calculate autoconversion coefficients from input constants and grid info; set set clw(:,:,1) to cloud liquid water +!! - otherwise: set autoconversion parameters like in Zhao-Carr and set critical relative humidity to 1 +!! . +!! ## If SHOC is active and is supposed to be called before convection, call it and update the state variables within. +!! - Prior to calling SHOC, prepare some microphysics variables: +!! - if Morrison et al. scheme: set 'skip_macro', fill clw(:,:,1,2) with cloud ice, liquid from the tracer array, and fill cloud droplet number concentration arrays from the input tracer array +!! - if Zhao-Carr scheme: initialize precip. mixing ratios to 0, fill clw(:,:,1,2) with cloud ice, liquid from the tracer array (as a function of temperature) +!! - Call 'shoc' (modifies state variables within the subroutine) +!! - Afterward, set updated cloud number concentrations in the tracer array from the updated 'ncpl' and 'ncpi' +!! . +!! ## Calculate and apply the state variable tendencies (within the subroutine) due to deep convection. +!! - Call deep convective scheme according to the parameter 'imfdeepcnv', 'ras', and 'cscnv'. +!! - if imfdeepcnv == 0, 1, or 2, no special processing is needed +!! - if the Chikira-Sugiyama scheme (cscnv), convert rain rate to accumulated rain (rain1) +!! - if RAS, initialize 'ccwfac', 'dlqfac', and revap before the call to 'rascnv' +!! - Zero out 'cld1d' (cloud work function calculated in non-RAS, non-Chikira-Sugiyama schemes) +!! - Update tracers in the tracer array (gq0) due to convective transport (RAS, CS only) from the 'clw' array +!! - Calculate accumulated surface convective precip. for this physics time step (rainc) +!! - If necessary, accumulate cloud work function, convective precipitation, and convective mass fluxes; accumulate dt3dt(:,:,4), dq3dt(:,:,2), du3dt(:,:,3), dv3dt(:,:,3) as change in state variables due to deep convection +!! - If PDF-based clouds are active and Zhao-Carr microphysics, save convective cloud cover and water in 'phy_f3d' array +!! - otherwise, if non-PDF-based clouds and the "convective cloudiness enhancement" is active, save convective cloud water in 'phy_f3d' array +!! . +!! ## Calculate the state variable tendencies due to convective gravity wave drag and apply them afterwards. +!! - Calculate the average deep convective heating rate in the column to pass into 'gwdc' +!! - Call 'gwdc' to calculate tendencies of u, v due to convective GWD +!! - For diagnostics, accumulate the vertically-integrated change in u, v due to conv. GWD; accumulate change in u, v, due to conv. GWD in du3dt(:,:,4) and dv3dt(:,:,4) +!! - Calculate updated values of u, v, T using conv. GWD tendencies +!! . +!! ## Calculate and apply the state variable tendencies (within the subroutine) due to shallow convection. +!! - If diagnostics are active, set 'dtdt' and 'dqdt' to updated values of T and q before shallow convection +!! - If SHOC is not active, do the following: +!! - for the mass-flux shallow convection scheme (imfshalcnv == 1), call 'shalcnv' +!! - for the scale- and aerosol-aware scheme (imfshalcnv == 2), call 'samfshalcnv' +!! - for either of the first two schemes, perform the following after the call: +!! - if Zhao-Carr microphysics with PDF-based clouds, save convective cloud water an cover in 'phy_f3d' +!! - if non-PDF-based clouds and convective cloudiness enhancement is active, save convective cloud water in 'phy_f3d' +!! - calculate shallow convective precip. and add it to convective precip; accumulate convective precip. +!! - for the Tiedtke scheme (imfshalcnv == 0), find the top level where shallow convection must stratosphere +!! - if using Moorthi's approach to stratus, call 'shalcv' +!! - otherwise, call 'shalcvt3' +!! - save the change in T and q due to shallow convection in dt3dt(:,:,5) and dq3dt(:,:,3); reset dtdt and dqdt to the updated values of T, q after shallow Convection +!! - if 'clw' is not partitioned into ice/water, set 'clw(ice)' to zero +!! - If SHOC is active (and shocaftcnv) +!! - if Morrison et al. scheme: set 'skip_macro' and fill cloud droplet number concentration arrays from the input tracer array +!! - initialize precip. mixing ratios to 0 +!! - call 'shoc' (modifies state variables within the subroutine) +!! - afterward, set updated cloud number concentrations in the tracer array from the updated 'ncpl' and 'ncpi' +!! . +!! ## Prepare for microphysics call by calculating preliminary variables. +!! - For Morrison et al. microphysics, set cloud water and ice arrays to the convecitvely transported values +!! - For Ferrier microphysics, combine convectively transported cloud water and ice with column rain and save in cloud water array +!! - calculate and save ice fraction and rain fraction in phy_f3d(1),(2) +!! - For Zhao-Carr, combine convectively transported cloud water and ice into the cloud water array +!! - Otherwise, combine convectively transported cloud water and ice into the convectively transported cloud water +!! - Call 'cnvc90'; a "legacy routine which determines convective clouds"; outputs 'acv','acvb','acvt','cv','cvb','cvt' +!! . +!! ## If necessary, call the moist convective adjustment subroutine and update the state temperature and moisture variable within. +!! - Updates T, q, 'rain1', cloud water array +!! - Accumulate convective precip +!! - For diagnostics, accumulate the change in T, q due to moist convective adjustment; reset 'dtdt' and 'dqdt' to updated T, q before call to microphysics +!! . +!! ## Calculate and apply the state variable tendencies (within the subroutine) due to microphysics. +!! - If no cloud microphysics (ncld == 0), call 'lrgscl' to update T, q and output large scale precipitation and cloud water +!! - Otherwise, a more advanced microphysics scheme is called (which scheme depends on values of 'num_p3d','do_shoc',and 'ncld') +!! - Ferrier scheme (num_p3d == 3): +!! - calculate droplet number concentration and minimum large ice fraction +!! - call 'gsmdrive' (modifies T, q, cloud water, 'f_ice', 'f_rain', 'f_rimef', 'rain1') +!! - Zhao-Carr-Sundqvist scheme (num_p3d == 4): +!! - if non-PDF-based clouds: +!! - if 'do_shoc', call 'precpd_shoc' (precpd modified for SHOC) +!! - else, call 'gscond' (grid-scale condensation/evaporation); updates water vapor, cloud water, temperature +!! - call 'precpd'; updates water vapor, cloud water, temperature and outputs precip., snow ratio, and rain water path +!! - for PDF-based clouds: +!! - call 'gscondp' followed by 'precpdp' (similar arguments to gscond, precpd above) +!! - Morrison et al. scheme (ncld = 2): +!! - if 'do_shoc', set clw(1),(2) from updated values; set phy_f3d(:,:,1) from phy_f3d(:,:,ntot3d-2) +!! - else, set clw(1),(2) from updated values; set phy_f3d(:,:,1) to cloud cover from previous time step + convective cloud water from convective scheme +!! - call 'm_micro_driver'; updates water vapor, temperature, droplet number concentrations, cloud cover +!! - Combine large scale and convective precip. +!! - For diagnostics, accumulate total surface precipitation and accumulate change in T and q due to microphysics in dt3dt(:,:,6) and dq3dt(:,:,4) +!! . +!! ## Determine the precipitation type and update land surface properties if necessary. +!! - If 'cal_pre', diagnose the surface precipitation type +!! - call 'calpreciptype'; set snow flag to 1 if snow or sleet, 0 otherwise +!! - For rain/snow decision, calculate temperature at 850 hPa (\f$T_{850}\f$) +!! - If not 'cal_pre', set snow flag to 1 if \f$T_{850}\f$ is below freezing +!! - For coupling, accumulate rain if \f$T_{850}\f$ is above freezing, otherwise accumulate snow +!! - If using the OSU land model, accumulate surface snow depth if \f$T_{850}\f$ is below freezing and not over an ocean surface +!! - call 'progt2' (canopy and soil moisture?) and set the soil liquid water equal to soil total water +!! - If necessary (lssav), update the 2m max/min values of T and q +!! - If necessary (lssav), accumulate total runoff and surface runoff. +!! . +!! ## Fill the output variables from the local variables as necessary and deallocate allocatable arrays. +!! - Set global sea ice thickness and concentration as well as the temperature of the sea ice +!! - Set global soil moisture variables +!! - Calculate precipitable water and water vapor mass change due to all physics for the column +!! - Deallocate arrays for SHOC scheme, deep convective scheme, and Morrison et al. microphysics + + + public GFS_physics_driver + + CONTAINS +!******************************************************************************************* + + subroutine GFS_physics_driver & + (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag) + + implicit none +! +! --- interface variables + type(GFS_control_type), intent(inout) :: Model + type(GFS_statein_type), intent(inout) :: Statein + type(GFS_stateout_type), intent(inout) :: Stateout + type(GFS_sfcprop_type), intent(inout) :: Sfcprop + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_grid_type), intent(inout) :: Grid + type(GFS_tbd_type), intent(inout) :: Tbd + type(GFS_cldprop_type), intent(inout) :: Cldprop + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag +! +! --- local variables + +!--- INTEGER VARIABLES + integer :: me, ipr, ix, im, levs, ntrac, nvdiff, kdt, & + ntoz, ntcw, ntiw, ncld,ntke,ntkev, ntlnc, ntinc, lsoil,& + ntrw, ntsw, ntrnc, ntsnc, ntot3d, ntgl, ntgnc, ntclamt,& + ims, ime, kms, kme, its, ite, kts, kte, imp_physics, & + ntwa, ntia, nmtvr + + integer :: i, kk, ic, itc, k, n, k1, iter, levshcm, tracers, & + tottracer, nsamftrac, num2, num3, nshocm, nshoc, ntk, & + nn, nncl, ntiwx, seconds + + integer, dimension(size(Grid%xlon,1)) :: & + kbot, ktop, kcnv, soiltyp, vegtype, kpbl, slopetyp, kinver, & + levshc, islmsk, & +!--- coupling inputs for physics + islmsk_cice + +!--- LOGICAL VARIABLES + logical :: lprnt, revap, mg3_as_mg2, skip_macro, trans_aero + + logical, dimension(size(Grid%xlon,1)) :: & + flag_iter, flag_guess, invrsn, & +!--- coupling inputs for physics + flag_cice + + logical, dimension(Model%ntrac+1,2) :: otspt + + real(kind=kind_phys), dimension(Model%ntrac+2) :: trcmin + +!--- REAL VARIABLES + real(kind=kind_phys) :: & + dtf, dtp, frain, tem, tem1, tem2, & + xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, & + txl, txi, txo, dt_warm, & +!--- experimental for shoc sub-stepping + dtshoc, & +!--- GFDL Cloud microphysics + crain, csnow, total_precip + + real(kind=kind_phys) :: rho + + + real(kind=kind_phys), dimension(Model%ntrac-Model%ncld+2) :: & + fscav, fswtr + + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + ccwfac, garea, dlength, cumabs, fice, zice, tice, gflx,& + rain1, snowmt, cd, cdq, qss, dusfcg, dvsfcg, dusfc1, & + dvsfc1, dtsfc1, dqsfc1, rb, drain, cld1d, evap, hflx, & + stress, t850, ep1d, gamt, gamq, sigmaf, & + wind, work1, work2, work3, work4, runof, xmu, fm10, fh2, & + tx1, tx2, tx3, tx4, ctei_r, evbs, evcw, trans, sbsno,& + snowc, frland, adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, & + adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, adjnirbmd, & + adjnirdfd, adjvisbmd, adjvisdfd, xcosz, tseal, & +! adjnirdfd, adjvisbmd, adjvisdfd, gabsbdlw, xcosz, tseal, & + snohf, dlqfac, ctei_rml, cldf, domr, domzr, domip, & + doms, psautco_l, prautco_l, ocalnirbm_cpl, ocalnirdf_cpl, & + ocalvisbm_cpl, ocalvisdf_cpl, dtzm, temrain1, t2mmp, q2mp, & + psaur_l, praur_l, & +!--- for CS-convection + wcbmax + +! 1 - land, 2 - ice, 3 - ocean + real(kind=kind_phys), dimension(size(Grid%xlon,1),3) :: & + zorl3, cd3, cdq3, rb3, stress3, ffmm3, ffhh3, uustar3, & + fm103, fh23, qss3, cmm3, chh3, gflx3, evap3, hflx3, ep1d3, & + weasd3, snowd3, tprcp3, tsfc3, tsurf3, adjsfculw3, semis3, & + gabsbdlw3 + + logical, dimension(size(Grid%xlon,1)) :: & + wet, dry, icy + + real(kind=kind_phys), dimension(size(Grid%xlon,1),1) :: & + area, land, rain0, snow0, ice0, graupel0 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%lsoil) :: & + smsoil, stsoil, slsoil + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & + del, rhc, dtdt, dudt, dvdt, dtdtc, & + ud_mf, dd_mf, dt_mf, prnum, dkt +! ud_mf, dd_mf, dt_mf, prnum, dkt, sigmatot, sigmafrac, txa + real(kind=kind_phys), allocatable, dimension(:,:) :: sigmatot, & + gwdcu, gwdcv, rainp, sigmafrac, tke + + +!--- GFDL modification for FV3 + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs+1) ::& + del_gz + real(kind=kind_phys), allocatable, dimension(:,:,:) :: & + delp, dz, uin, vin, pt, qv1, ql1, qr1, qg1, qa1, qn1, qi1, & + qs1, pt_dt, qa_dt, udt, vdt, w, qv_dt, ql_dt, qr_dt, qi_dt, & + qs_dt, qg_dt, p123, refl +! + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%ntrac) :: & + dqdt + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,oz_coeff+5) :: & + dq3dt_loc + +! mg, sfc perts + real (kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + z01d, zt1d, bexp1d, xlai1d, alb1d, vegf1d + real(kind=kind_phys) :: cdfz +!--- ALLOCATABLE ELEMENTS + !--- in clw, the first two varaibles are cloud water and ice. + !--- from third to ntrac are convective transportable tracers, + !--- third being the ozone, when ntrac=3 (valid with ras, csaw, or samf) + !--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow, + !--- rain, and their numbers + real(kind=kind_phys), allocatable :: & + clw(:,:,:), qrn(:,:), qsnw(:,:), ncpl(:,:), ncpi(:,:), & + ncpr(:,:), ncps(:,:), cnvc(:,:), cnvw(:,:), & + qgl(:,:), ncgl(:,:) +!--- for 2 M microphysics +! real(kind=kind_phys), allocatable, dimension(:) :: & +! cn_prc, cn_snr + real(kind=kind_phys), allocatable, dimension(:,:) :: & +! qlcn, qicn, w_upi, cf_upi, CNV_MFD, CNV_PRC3, CNV_DQLDT, & + qlcn, qicn, w_upi, cf_upi, CNV_MFD, CNV_DQLDT, & + CLCN, CNV_FICE, CNV_NDROP, CNV_NICE +! real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.02, & +! real(kind=kind_phys),parameter :: slope_mg = 0.02, slope_upmg = 0.04, & +! turnrhcrit = 0.900, turnrhcrit_upper = 0.150 +! in the following inverse of slope_mg and slope_upmg are specified + real(kind=kind_phys),parameter :: slope_mg = 50.0_kind_phys, & + slope_upmg = 25.0_kind_phys +! + !--- for 2 M Thompson MP + real(kind=kind_phys), allocatable, dimension(:,:,:) :: & + vdftra, dvdftra + real(kind=kind_phys), allocatable, dimension(:,:) :: & + ice00, liq0 +! real(kind=kind_phys), allocatable, dimension(:) :: nwfa2d + real(kind=kind_phys), parameter :: liqm = 4./3.*con_pi*1.e-12, & + icem = 4./3.*con_pi*3.2768*1.e-14*890. +!=============================================================================== +! +! vay --- local variables Local PdXdt after each Physics chain +! TdXdt total Tendency for X due to ALL GFS_physics except +! radiance +! vay-2018 PROCESS-oriented diagnostics for 3D-fields in UGWP for COORDE +! +! New 2D-process oriented arrays for Daily mean (6-hr aver) diagnostics +! Diag%dXdT_pbl Diag%dXdT_ogw Diag%dXdT_congw Diag%dXdT_moist +! Diag%dXdT_total +! Additional 2D/3D diagnostic containers and arrays +! + logical :: ldiag_ugwp + +! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & + real(kind=kind_phys) & + Pdtdt, Pdudt, Pdvdt +! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & +! Tdtdt, Tdudt, Tdvdt +!----------------------------------------- +! ugwp: oro-stationary + non-stationary +!----------------------------------------- + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: hprime, & + sigma, elvmax, oc, theta, gamma + real(kind=kind_phys), dimension(size(Grid%xlon,1),4) :: oa4, clx + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: sgh30 !proxy for small-scale turb oro +! + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & + gw_dudt, gw_dvdt, gw_dtdt, gw_kdis +! + real(kind=kind_phys) :: ftausec, fdaily, fwindow + integer :: master + +! COODRE-averaged diagnostics +! + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: ax_mtb, & + ax_ogw, ax_tms, ax_ngw + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + tau_tms, tau_mtb, tau_ogw, tau_ngw + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + zm_mtb, zm_ogw, zm_ngw, zm_lwb +!------------------------------------------------------ +! parameters for canopy heat storage parametrization +!------------------------------------------------------ + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + hflxq, evapq, hffac, hefac + real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 + real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + real (kind=kind_phys), parameter :: z0ice=1.1 +! +!=============================================================================== + + real, allocatable, dimension(:) :: refd, REFD263K + integer :: kdtminus1 + logical :: reset +! For computing saturation vapor pressure and rh at 2m + real :: pshltr,QCQ,rh02 + real(kind=kind_phys), allocatable, dimension(:,:) :: den + + real(kind=kind_phys) :: lndp_vgf + +!-------------------------------------------------------------------------------- + !! Initialize local variables (for debugging purposes only, + !! because the corresponding variables Interstitial(nt)%... + !! are reset to zero every time). + !snowmt = 0. + !gamq = 0. + !gamt = 0. + !gflx = 0. + !hflx = 0. +!-------------------------------------------------------------------------------- + + !! Strictly speaking, this is not required. But when + !! hunting for bit-for-bit differences, doing the same as + !! in GFS_suite_stateout_reset makes life a lot easier. + !Stateout%gt0(:,:) = Statein%tgrs(:,:) + !Stateout%gu0(:,:) = Statein%ugrs(:,:) + !Stateout%gv0(:,:) = Statein%vgrs(:,:) + !Stateout%gq0(:,:,:) = Statein%qgrs(:,:,:) +!-------------------------------------------------------------------------------- + +!===> ... begin here + ldiag_ugwp = Model%ldiag_ugwp +! +!===> + master = Model%master + + me = Model%me + ix = size(Grid%xlon,1) + im = size(Grid%xlon,1) + ipr = min(im,10) + levs = Model%levs + lsoil = Model%lsoil + ntrac = Model%ntrac + dtf = Model%dtf + dtp = Model%dtp + +!------- +! For COORDE-2019 averaging with fwindow, it was done before +! 3Diag fixes and averaging ingested using "fdaily"-factor +! + ftausec = 86400.0 + fdaily = dtp / ftausec + if (Model%fhzero /= 0) then + ftausec = Model%fhzero*3600 + fwindow = dtp/ftausec + fdaily = fwindow + else + print *, 'VAY Model%fhzero = 0., Bad Averaged-diagnostics ' + endif +!------- + + kdt = Model%kdt + lprnt = Model%lprnt + nvdiff = ntrac ! vertical diffusion of all tracers! + ntcw = Model%ntcw + ntoz = Model%ntoz + ntiw = Model%ntiw + ncld = Model%ncld + ntke = Model%ntke +! + ntlnc = Model%ntlnc + ntinc = Model%ntinc + ntrw = Model%ntrw + ntsw = Model%ntsw + ntrnc = Model%ntrnc + ntsnc = Model%ntsnc + ntgl = Model%ntgl + ntgnc = Model%ntgnc + ntclamt = Model%ntclamt + ntot3d = Model%ntot3d + ntwa = Model%ntwa + ntia = Model%ntia + nmtvr = Model%nmtvr + + imp_physics = Model%imp_physics + + nncl = ncld + + ! perform aerosol convective transport and PBL diffusion + trans_aero = Model%cplchm .and. Model%trans_trac + + if (imp_physics == Model%imp_physics_thompson) then + if (Model%ltaerosol) then + nvdiff = 8 + else + nvdiff = 5 + endif + if (Model%satmedmf) nvdiff = nvdiff + 1 + nncl = 5 + elseif (imp_physics == Model%imp_physics_wsm6) then + nvdiff = ntrac -3 + if (Model%satmedmf) nvdiff = nvdiff + 1 + nncl = 5 + elseif (ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount + nvdiff = ntrac - 1 + endif + + if (imp_physics == Model%imp_physics_gfdl) then + nncl = 5 + endif + + if (imp_physics == Model%imp_physics_mg) then + if (abs(Model%fprcp) == 1) then + nncl = 4 ! MG2 with rain and snow + mg3_as_mg2 = .false. + elseif (Model%fprcp >= 2) then + if (ntgl > 0 .and. (Model%mg_do_graupel .or. Model%mg_do_hail)) then + nncl = 5 ! MG3 with rain and snow and grapuel/hail + mg3_as_mg2 = .false. + else ! MG3 code run without graupel/hail i.e. as MG2 + nncl = 4 + mg3_as_mg2 = .true. + endif + endif + endif +! + if (Model%cplchm) then + ! Only Zhao/Carr/Sundqvist and GFDL microphysics schemes are supported + ! when coupling with chemistry. PBL diffusion of aerosols is only supported + ! Adding MG microphysics - Moorthi + if (imp_physics == Model%imp_physics_zhao_carr) then + nvdiff = 3 + elseif (imp_physics == Model%imp_physics_mg) then + if (ntgl > 0) then + nvdiff = 12 + else + nvdiff = 10 + endif + elseif (imp_physics == Model%imp_physics_gfdl) then + nvdiff = 7 + endif + if (trans_aero) nvdiff = nvdiff + Model%ntchm + if (ntke > 0) nvdiff = nvdiff + 1 ! adding tke to the list + endif +! + kdtminus1 = kdt - 1 + reset = mod(kdtminus1, nint(Model%avg_max_length/dtp)) == 0 + +! +!------------------------------------------------------------------------------------------- +! lprnt = .false. + +! do i=1,im +! lprnt = Model%me == 23 .and. i == 25 +! lprnt = Model%me == 127 .and. i == 11 +! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-295.40) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-47.0) < 0.101 +! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 & +! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301 +! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg-81.23) < 0.101 +! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-28.800) < 0.101 & +! .and. abs(grid%xlat(i)*rad2dg+2.45) < 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) & +! write(2000+me,*)' i=',i,' xlon=',grid%xlon(i)*rad2dg, & +! ' xlat=',grid%xlat(i)*rad2dg,' me=',me +! if (lprnt) then +! ipr = i +! write(0,*)' ipr=',ipr,'xlon=',grid%xlon(i)*rad2dg,' xlat=',grid%xlat(i)*rad2dg,' me=',me +! exit +! endif +! enddo +! if (lprnt) then +! if (Model%cplflx) then +! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, & +! ' fice=',Sfcprop%fice(ipr),' ulw=',Coupling%ulwsfcin_cpl(ipr), & +! ' tsfc=',Sfcprop%tsfc(ipr) +! else +! write(0,*)' sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt, & +! ' fice=',Sfcprop%fice(ipr), ' tsfc=',Sfcprop%tsfc(ipr), & +! 'tsfcl=',Sfcprop%tsfcl(ipr),' tsfco=',Sfcprop%tsfco(ipr) +! endif +! if (Model%nstf_name(1) > 0) then +! write(0,*)' begin sfcprop%tref=',Sfcprop%tref(ipr),' kdt=',kdt, & +! ' landfrac=',Sfcprop%landfrac(ipr) +! endif +! endif +!------------------------------------------------------------------------------------------- +! +! if (lprnt) then +! write(0,*)' in phydrv tgrs=',Statein%tgrs(ipr,:) +! write(0,*)' in phydrv ugrs=',Statein%ugrs(ipr,:) +! write(0,*)' in phydrv vgrs=',Statein%vgrs(ipr,:) +! write(0,*)' in phydrv qgrs=',Statein%qgrs(ipr,:,1)*1000.0 +! write(0,*)' in phydrv tke=',Statein%qgrs(ipr,:,ntke) +! write(0,*)' in phydrv phii=',Statein%phii(ipr,:) +! endif +! +! --- ... frain=factor for centered difference scheme correction of rain amount. + + frain = dtf / dtp + + skip_macro = .false. + if (ntiw > 0) then + if (ntclamt > 0) then + nn = ntrac - 2 + else + nn = ntrac - 1 + endif + elseif (ntcw > 0) then + nn = ntrac + else + nn = ntrac + 1 + endif + allocate (clw(ix,levs,nn)) + if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & + (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & + (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then + allocate (cnvc(ix,levs), cnvw(ix,levs)) + do k=1,levs + do i=1,im + cnvc(i,k) = zero + cnvw(i,k) = zero + enddo + enddo + if (Model%npdf3d == 3 .and. Model%num_p3d == 4) then + num2 = Model%num_p3d + 2 + num3 = num2 + 1 + elseif (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) then + num2 = Model%num_p3d + 1 + endif + endif + +! --- set initial quantities for stochastic physics deltas + if (Model%do_sppt .or. Model%ca_global)then + Tbd%dtdtr = zero + endif + +! mg, sfc-perts +! --- scale random patterns for surface perturbations with perturbation size +! --- turn vegetation fraction pattern into percentile pattern +! since this function occurs in GFS_typedefs.F90/interstitial_phys_reset + do i=1,im + z01d(i) = zero + zt1d(i) = zero + bexp1d(i) = zero + xlai1d(i) = zero +! alb1d(i) = zero + vegf1d(i) = zero + enddo + lndp_vgf=-999. + + if (Model%lndp_type==1) then + do k =1,Model%n_var_lndp + select case(Model%lndp_var_list(k)) + case ('rz0') + z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('rzt') + zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('shc') + bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) + case ('lai') + xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('vgf') +! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff + do i=1,im + call cdfnor(Coupling%sfc_wts(i,k),cdfz) + vegf1d(i) = cdfz + enddo + lndp_vgf = Model%lndp_prt_list(k) + end select + enddo + endif +! + if (Model%do_shoc) then + allocate (qrn(im,levs), qsnw(im,levs), & + ncpl(im,levs), ncpi(im,levs)) + do k=1,levs + do i=1,im + ncpl(i,k) = zero + ncpi(i,k) = zero + qrn(i,k) = zero + qsnw(i,k) = zero + enddo + enddo + endif + if (imp_physics == Model%imp_physics_thompson) then + if(Model%ltaerosol) then + allocate(ice00(im,levs)) + allocate(liq0(im,levs)) +! allocate(nwfa2d(im)) + else + allocate(ice00(im,levs)) + endif + endif + if (imp_physics == Model%imp_physics_mg) then ! For MGB double moment microphysics + allocate (qlcn(im,levs), qicn(im,levs), w_upi(im,levs), & + cf_upi(im,levs), CNV_MFD(im,levs), & +! cf_upi(im,levs), CNV_MFD(im,levs), CNV_PRC3(im,levs), & + CNV_DQLDT(im,levs), clcn(im,levs), cnv_fice(im,levs), & + cnv_ndrop(im,levs), cnv_nice(im,levs)) +! allocate (cn_prc(im), cn_snr(im)) + allocate (ncpr(im,levs), ncps(im,levs), ncgl(im,levs)) + if (.not. allocated(qrn)) allocate (qrn(im,levs)) + if (.not. allocated(qsnw)) allocate (qsnw(im,levs)) + if (.not. allocated(qgl)) allocate (qgl(im,levs)) + do k=1,levs + do i=1,im + qrn(i,k) = zero + qsnw(i,k) = zero + qgl(i,k) = zero + ncpr(i,k) = zero + ncps(i,k) = zero + ncgl(i,k) = zero + enddo + enddo + else + allocate (qlcn(1,1), qicn(1,1), w_upi(1,1), cf_upi(1,1), & + CNV_MFD(1,1), CNV_DQLDT(1,1), & +! CNV_MFD(1,1), CNV_PRC3(1,1), CNV_DQLDT(1,1), & + clcn(1,1), cnv_fice(1,1), cnv_ndrop(1,1), cnv_nice(1,1)) + if (imp_physics == Model%imp_physics_gfdl) then ! GFDL MP + allocate (delp(im,1,levs), dz(im,1,levs), uin(im,1,levs), & + vin(im,1,levs), pt(im,1,levs), qv1(im,1,levs), ql1(im,1,levs), & + qr1(im,1,levs), qg1(im,1,levs), qa1(im,1,levs), qn1(im,1,levs), & + qi1(im,1,levs), qs1(im,1,levs), pt_dt(im,1,levs), qa_dt(im,1,levs),& + udt(im,1,levs), vdt(im,1,levs), w(im,1,levs), qv_dt(im,1,levs),& + ql_dt(im,1,levs), qr_dt(im,1,levs), qi_dt(im,1,levs), qs_dt(im,1,levs),& + qg_dt(im,1,levs), p123(im,1,levs), refl(im,1,levs), den(im,levs)) + endif + endif + +#ifdef GFS_HYDRO + call get_prs(im, ix, levs, ntrac, Statein%tgrs, Statein%qgrs, & + Model%thermodyn_id, Model%sfcpress_id, & + Model%gen_coord_hybrid, Statein%prsi, Statein%prsik, & + Statein%prsl, Statein%prslk, Statein%phii, Statein%phil, del) +#else +!GFDL Adjust the geopotential height hydrostatically in a way consistent with FV3 discretization +! if (lprnt) write(0,*)'bef get_prs_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt + + call get_prs_fv3 (ix, levs, ntrac, Statein%phii, Statein%prsi, & + Statein%tgrs, Statein%qgrs, del, del_gz) +#endif +! if (lprnt) write(0,*)'aft get_prs_fv3 phii=',Statein%phii(ipr,:) +! if (lprnt) write(0,*)'aft get_prs_fv3 del_gz=',del_gz(ipr,:) + + do i = 1, IM + sigmaf(i) = max( Sfcprop%vfrac(i),0.01_kind_phys ) + islmsk(i) = nint(Sfcprop%slmsk(i)) + islmsk_cice(i) = islmsk(i) + + if (islmsk(i) == 2) then + if (Model%isot == 1) then + soiltyp(i) = 16 + else + soiltyp(i) = 9 + endif + if (Model%ivegsrc == 1) then + vegtype(i) = 15 + elseif(Model%ivegsrc == 2) then + vegtype(i) = 13 + endif + slopetyp(i) = 9 + else + soiltyp(i) = int( Sfcprop%stype(i)+half ) + vegtype(i) = int( Sfcprop%vtype(i)+half ) + slopetyp(i) = int( Sfcprop%slope(i)+half ) !! clu: slope -> slopetyp + if (soiltyp(i) < 1) soiltyp(i) = 14 + if (vegtype(i) < 1) vegtype(i) = 17 + if (slopetyp(i) < 1) slopetyp(i) = 1 + endif +! --- ... xw: transfer ice thickness & concentration from global to local variables + zice(i) = Sfcprop%hice(i) + fice(i) = Sfcprop%fice(i) + tice(i) = Sfcprop%tisfc(i) +! +!GFDL work1(i) = (log(coslat(i) / (nlons(i)*latr)) - dxmin) * dxinv +!GFS Moorthi thinks this should be area and not dx +! work1(i) = (log(Grid%dx(i)) - dxmin) * dxinv + work1(i) = (log(Grid%area(i)) - dxmin) * dxinv + work1(i) = max(zero, min(one, work1(i))) + work2(i) = one - work1(i) + Diag%psurf(i) = Statein%pgr(i) + work3(i) = Statein%prsik(i,1) / Statein%prslk(i,1) +!GFDL tem1 = con_rerth * (con_pi+con_pi)*coslat(i)/nlons(i) +!GFDL tem2 = con_rerth * con_pi / latr +!GFDL garea(i) = tem1 * tem2 + tem1 = Grid%dx(i) + tem2 = Grid%dx(i) + garea(i) = Grid%area(i) + dlength(i) = sqrt( tem1*tem1+tem2*tem2 ) + cldf(i) = Model%cgwf(1) * work1(i) + Model%cgwf(2) * work2(i) + wcbmax(i) = Model%cs_parm(1) * work1(i) + Model%cs_parm(2) * work2(i) + dry(i) = .false. + icy(i) = .false. + wet(i) = .false. + flag_cice(i) = .false. + enddo +! + if (Model%cplflx) then + do i=1,im + islmsk_cice(i) = nint(Coupling%slimskin_cpl(i)) + flag_cice(i) = (islmsk_cice(i) == 4) + enddo + endif + + if (Model%frac_grid) then + do i = 1, IM + frland(i) = Sfcprop%landfrac(i) + if (frland(i) > zero) dry(i) = .true. + if (frland(i) < one) then + if (Sfcprop%oceanfrac(i) > zero) then + if (fice(i) >= Model%min_seaice) then + icy(i) = .true. + Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + if (Model%cplflx) then + islmsk_cice(i) = 4 + flag_cice(i) = .true. + endif + islmsk(i) = 2 + else + fice(i) = zero + flag_cice(i) = .false. + islmsk_cice(i) = 0 + islmsk(i) = 0 + endif + if (fice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. Model%cplflx .and. icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif + else + if (fice(i) >= Model%min_lakeice) then + icy(i) = .true. + islmsk(i) = 2 + Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + else + fice(i) = zero + islmsk(i) = 0 + endif +! islmsk_cice(i) = islmsk(i) + if (fice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif + endif + else + fice(i) = zero + endif + enddo + else + do i = 1, IM + if (islmsk(i) == 1) then +! Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + dry(i) = .true. + frland(i) = one + fice(i) = zero + else + frland(i) = zero + if (Sfcprop%oceanfrac(i) > zero) then + if (fice(i) >= Model%min_seaice) then + icy(i) = .true. + else + fice(i) = zero + flag_cice(i) = .false. + islmsk_cice(i) = 0 + islmsk(i) = 0 + endif + if (fice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. Model%cplflx .and. icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif + else + if (fice(i) >= Model%min_lakeice) then + icy(i) = .true. + else + fice(i) = zero + islmsk(i) = 0 + endif + if (fice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) + endif + endif + endif + enddo + endif +! + do k=1,3 + do i=1,im + cd3(i,k) = huge + cdq3(i,k) = huge + rb3(i,k) = huge + stress3(i,k) = huge + ffmm3(i,k) = huge + ffhh3(i,k) = huge + fm103(i,k) = huge + fh23(i,k) = huge + qss3(i,k) = huge + cmm3(i,k) = huge + chh3(i,k) = huge + gflx3(i,k) = zero +! gflx3(i,k) = huge + evap3(i,k) = huge + hflx3(i,k) = huge + ep1d3(i,k) = huge + uustar3(i,k) = huge + weasd3(i,k) = huge + snowd3(i,k) = huge + tprcp3(i,k) = Sfcprop%tprcp(i) + tsfc3(i,k) = huge + tsurf3(i,k) = huge + zorl3(i,k) = huge +! oro3(i,k) = Sfcprop%oro(i) +! oro_uf3(i,k) = Sfcprop%oro_uf(i) + adjsfculw3(i,k) = zero + gabsbdlw3(i,k) = zero + enddo + enddo + zorl3(:,2) = z0ice + +! if (.not. Model%cplflx .or. .not. Model%frac_grid) then +! 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 +! if (lprnt) write(0,*)' dry=',dry(ipr),' wet=',wet(ipr),' icy=',icy(ipr) ,& +! ' tsfco=',Sfcprop%tsfco(ipr) + do i=1,im + if(wet(i)) then ! Water + zorl3(i,3) = Sfcprop%zorlo(i) + tsfc3(i,3) = Sfcprop%tsfco(i) + tsurf3(i,3) = Sfcprop%tsfco(i) +! weasd3(i,3) = Sfcprop%weasd(i) +! snowd3(i,3) = Sfcprop%snowd(i) + snowd3(i,3) = zero + weasd3(i,3) = zero + semis3(i,3) = 0.984_kind_phys + endif +! + if (dry(i)) then ! Land + uustar3(i,1) = Sfcprop%uustar(i) + weasd3(i,1) = Sfcprop%weasd(i) + zorl3(i,1) = Sfcprop%zorll(i) + tsfc3(i,1) = Sfcprop%tsfcl(i) + tsurf3(i,1) = Sfcprop%tsfcl(i) + snowd3(i,1) = Sfcprop%snowd(i) + semis3(i,1) = Radtend%semis(i) + endif +! + if (icy(i)) then ! Ice + uustar3(i,2) = Sfcprop%uustar(i) + weasd3(i,2) = Sfcprop%weasd(i) + zorl3(i,2) = Sfcprop%zorli(i) + tsfc3(i,2) = Sfcprop%tisfc(i) + tsurf3(i,2) = Sfcprop%tisfc(i) + tice(i) = Sfcprop%tisfc(i) + snowd3(i,2) = Sfcprop%snowd(i) + ep1d3(i,2) = zero + gflx3(i,2) = zero + semis3(i,2) = 0.95_kind_phys + endif + if (nint(Sfcprop%slmsk(i)) /= 1) Sfcprop%slmsk(i) = islmsk(i) + enddo + +! --- ... transfer soil moisture and temperature from global to local variables + do k=1,lsoil + do i=1,im + smsoil(i,k) = Sfcprop%smc(i,k) + stsoil(i,k) = Sfcprop%stc(i,k) + slsoil(i,k) = Sfcprop%slc(i,k) !! clu: slc -> slsoil + enddo + enddo + + do k=1,levs + do i=1,im + dudt(i,k) = zero + dvdt(i,k) = zero + dtdt(i,k) = zero + dtdtc(i,k) = zero + +!vay-2018 +! Pure tendency arrays w/o accumulation of Phys-tendencies from each +! chain of GFS-physics (later add container for species) +! +! Pdudt(i,k) = zero +! Pdvdt(i,k) = zero +! Pdtdt(i,k) = zero + +! +!ugwp-marked can be later accumulated as Pdudt Pdvdt Pdtdt +! + gw_dudt(i,k) = zero + gw_dvdt(i,k) = zero + gw_dtdt(i,k) = zero + gw_kdis(i,k) = zero + enddo + enddo + do n=1,ntrac + do k=1,levs + do i=1,im + dqdt(i,k,n) = zero + enddo + enddo + enddo + +!----------------------------------------------- +!vay-2018-19 ORO/UGWP process-oriented diagnostics +! + if (ldiag_ugwp) then + do i=1,im + tau_tms(i) = zero ; tau_mtb(i) = zero + tau_ogw(i) = zero ; tau_ngw(i) = zero + zm_mtb(i) = zero ; zm_lwb(i) = zero + zm_ogw(i) = zero ; zm_ngw(i) = zero + enddo + do k=1,levs + do i=1,im + ax_mtb(i,k) = zero ; ax_ogw(i,k) = zero + ax_tms(i,k) = zero ; ax_ngw(i,k) = zero + enddo + enddo + endif + + if (mod((kdt-1)*dtp, ftausec) == zero) then + do i=1,im + Diag%tau_tofd(i) = zero + Diag%tau_mtb(i) = zero + Diag%tau_ogw(i) = zero + Diag%tau_ngw(i) = zero + Diag%zmtb(i) = zero + Diag%zlwb(i) = zero + Diag%zogw(i) = zero +! Diag%dugwd(i) = zero +! Diag%dvgwd(i) = zero + enddo + endif +!=========================== +! can be taken out by "call Diag%zero" => call Diag(nb)%phys_zero (Model) +! in GFS_driver.F90 +! It can be also done by hands w/o +! relying on FV3GFS_io_mod +!================================= + if (ldiag_ugwp) then +! do k=1,levs +! do i=1,im +! Diag%du3dt_pbl(i,k) = zero +! Diag%dv3dt_pbl(i,k) = zero +! Diag%dt3dt_pbl(i,k) = zero +! +! Diag%du3dt_ogw(i,k) = zero +! Diag%dv3dt_ogw(i,k) = zero +! Diag%dt3dt_ogw(i,k) = zero + +! Diag%du3dt_mtb(i,k) = zero +! Diag%dv3dt_mtb(i,k) = zero +! Diag%dt3dt_mtb(i,k) = zero + +! Diag%du3dt_tms(i,k) = zero +! Diag%dv3dt_tms(i,k) = zero +! Diag%dt3dt_tms(i,k) = zero + +! Diag%du3dt_ngw(i,k) = zero +! Diag%dv3dt_ngw(i,k) = zero +! Diag%dt3dt_ngw(i,k) = zero +! +! employed for "storage" of State%out to compute DyCore_Tendencies +!! Diag%du3dt_cgw(i,k) = zero +!! Diag%dv3dt_cgw(i,k) = zero +!! Diag%dt3dt_cgw(i,k) = zero + +! Diag%du3dt_moist(i,k) = zero +! Diag%dv3dt_moist(i,k) = zero +! Diag%dt3dt_moist(i,k) = zero + +! Diag%dudt_tot(i,k) = zero +! Diag%dvdt_tot(i,k) = zero +! Diag%dtdt_tot(i,k) = zero + +! Diag%uav_ugwp(i,k) = zero +! Diag%tav_ugwp(i,k) = zero + +! +! Tdudt(i,k) = zero +! Tdvdt(i,k) = zero +! Tdtdt(i,k) = zero +! enddo +! enddo +! + if (kdt > 1) then + do k=1,levs + do i=1,im +! +!---- dycore_tend = Statein - Stateout , assuming that Statein-after Dycore and out-after Physics +! Statein%ugrs-- "Stateout%gu0 = Diag%du3dt_cgw" +! + Diag%dudt_tot(i,k) = (Statein%ugrs(i,k) - Diag%du3dt_cgw(i,k))*fdaily & + + Diag%dudt_tot(i,k) ! + Diag%dtdt_tot(i,k) = (Statein%tgrs(i,k) - Diag%dt3dt_cgw(i,k))*fdaily & + + Diag%dtdt_tot(i,k) + enddo + enddo + if (kdt == -2) then + print *, maxval(Statein%ugrs), maxval(Diag%du3dt_cgw), ' max Uin-out' + print *, minval(Statein%ugrs), minval(Diag%du3dt_cgw), ' min Uin-out' + print *, maxval(Statein%tgrs), maxval(Diag%dt3dt_cgw), ' max Tin-out' + print *, minval(Statein%tgrs), minval(Diag%dt3dt_cgw), ' min Tin-out' + endif + endif + endif +!===========================Above Phys-tend Diag for COORDE ====================== + +! --- ... initialize dtdt with heating rate from dcyc2 + +! --- ... adjust mean radiation fluxes and heating rates to fit for +! faster model time steps. +! sw: using cos of zenith angle as scaling factor +! lw: using surface air skin temperature as scaling factor + if (Model%pre_rad) then + call dcyc2t3_pre_rad & +! --- inputs: + ( Model%solhr, Model%slag, Model%sdec, Model%cdec, Grid%sinlat, & + Grid%coslat, Grid%xlon, Radtend%coszen, Sfcprop%tsfc, & + Statein%tgrs(1,1), Statein%tgrs(1,1), Coupling%sfcdsw, & + Coupling%sfcnsw, Coupling%sfcdlw, Radtend%htrsw, Radtend%htrlw,& + Coupling%nirbmui, Coupling%nirdfui, Coupling%visbmui, & + Coupling%visdfui, Coupling%nirbmdi, Coupling%nirdfdi, & + Coupling%visbmdi, Coupling%visdfdi, ix, im, levs, & +! --- input/output: + dtdt, & +! --- outputs: + adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & + adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd & + ) + + else + call dcyc2t3 & +! --- inputs: + ( Model%solhr, Model%slag, Model%sdec, Model%cdec, Grid%sinlat, & + Grid%coslat, Grid%xlon, Radtend%coszen, tsfc3, & +! Statein%tgrs(1,1), Radtend%tsflw, Radtend%semis, & + Statein%tgrs(1,1), Radtend%tsflw, semis3, & + Coupling%sfcdsw, Coupling%sfcnsw, Coupling%sfcdlw, & + Radtend%htrsw, Radtend%swhc, Radtend%htrlw, Radtend%lwhc,& + Coupling%nirbmui, Coupling%nirdfui, Coupling%visbmui, & + Coupling%visdfui, Coupling%nirbmdi, Coupling%nirdfdi, & + Coupling%visbmdi, Coupling%visdfdi, ix, im, levs, dtf, & + Model%fhswr, dry, icy, wet, & +! lprnt, ipr, & +! --- input/output: + dtdt, dtdtc, & +! --- outputs: + adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw3, xmu, xcosz, & + adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & + adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd & + ) +! +! save temp change due to radiation - need for sttp stochastic physics +!--------------------------------------------------------------------- + endif +! + if (Model%lsidea) then !idea jw + dtdt(:,:) = zero + endif + +! --- convert lw fluxes for land/ocean/sea-ice models +! note: for sw: adjsfcdsw and adjsfcnsw are zenith angle adjusted downward/net fluxes. +! for lw: adjsfcdlw is (sfc temp adjusted) downward fluxe with no emiss effect. +! adjsfculw is (sfc temp adjusted) upward fluxe including emiss effect. +! one needs to be aware that that the absorbed downward lw flux (used by land/ocean +! models as downward flux) is not the same as adjsfcdlw but a value reduced by +! the factor of emissivity. however, the net effects are the same when seeing +! it either above the surface interface or below. +! +! - flux above the interface used by atmosphere model: +! down: adjsfcdlw; up: adjsfculw = sfcemis*sigma*T**4 + (1-sfcemis)*adjsfcdlw +! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) +! - flux below the interface used by lnd/oc/ice models: +! down: sfcemis*adjsfcdlw; up: sfcemis*sigma*T**4 +! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) + +! --- ... define the downward lw flux absorbed by ground + + do i=1,im + if (dry(i)) gabsbdlw3(i,1) = semis3(i,1) * adjsfcdlw(i) + if (icy(i)) gabsbdlw3(i,2) = semis3(i,2) * adjsfcdlw(i) + if (wet(i)) gabsbdlw3(i,3) = semis3(i,3) * adjsfcdlw(i) + enddo + + if (Model%lssav) then ! --- ... accumulate/save output variables + +! --- ... sunshine duration time is defined as the length of time (in mdl output +! interval) that solar radiation falling on a plane perpendicular to the +! direction of the sun >= 120 w/m2 + + do i=1,im + if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg + tem1 = adjsfcdsw(i) / xcosz(i) + if ( tem1 >= 120.0_kind_phys) then + Diag%suntim(i) = Diag%suntim(i) + dtf + endif + endif + enddo + +! --- ... sfc lw fluxes used by atmospheric model are saved for output + + if (Model%frac_grid) then + do i=1,im + tem = (one - frland(i)) * fice(i) ! tem = ice fraction wrt whole cell + if (flag_cice(i)) then + adjsfculw(i) = adjsfculw3(i,1) * frland(i) & + + Coupling%ulwsfcin_cpl(i) * tem & + + adjsfculw3(i,3) * (one - frland(i) - tem) + else + adjsfculw(i) = adjsfculw3(i,1) * frland(i) & + + adjsfculw3(i,2) * tem & + + adjsfculw3(i,3) * (one - frland(i) - tem) + endif + enddo + else + do i=1,im + if (dry(i)) then ! all land + adjsfculw(i) = adjsfculw3(i,1) + elseif (icy(i)) then ! ice (and water) + tem = one - fice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw3(i,3) /= huge) then + adjsfculw(i) = Coupling%ulwsfcin_cpl(i)*fice(i) + adjsfculw3(i,3)*tem + else + adjsfculw(i) = Coupling%ulwsfcin_cpl(i) + endif + else + if (wet(i) .and. adjsfculw3(i,3) /= huge) then + adjsfculw(i) = adjsfculw3(i,2)*fice(i) + adjsfculw3(i,3)*tem + else + adjsfculw(i) = adjsfculw3(i,2) + endif + endif + else ! all water + adjsfculw(i) = adjsfculw3(i,3) + endif + enddo + endif +! if (lprnt) write(0,*)' kdt=',kdt,' tsfc=',Sfcprop%tsfc(ipr),' adjsfculw=',adjsfculw(ipr),& +! ' adjsfculw3=',adjsfculw3(ipr,:),' icefr=',fice(ipr),' tsfc3=',tsfc3(ipr,:) +! + do i=1,im + Diag%dlwsfc(i) = Diag%dlwsfc(i) + adjsfcdlw(i)*dtf + Diag%ulwsfc(i) = Diag%ulwsfc(i) + adjsfculw(i)*dtf + Diag%psmean(i) = Diag%psmean(i) + Statein%pgr(i)*dtf ! mean surface pressure + enddo + + if (Model%ldiag3d) then + if (Model%lsidea) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,1) = Diag%dt3dt(i,k,1) + Radtend%lwhd(i,k,1)*dtf + Diag%dt3dt(i,k,2) = Diag%dt3dt(i,k,2) + Radtend%lwhd(i,k,2)*dtf + Diag%dt3dt(i,k,3) = Diag%dt3dt(i,k,3) + Radtend%lwhd(i,k,3)*dtf + Diag%dt3dt(i,k,4) = Diag%dt3dt(i,k,4) + Radtend%lwhd(i,k,4)*dtf + Diag%dt3dt(i,k,5) = Diag%dt3dt(i,k,5) + Radtend%lwhd(i,k,5)*dtf + Diag%dt3dt(i,k,6) = Diag%dt3dt(i,k,6) + Radtend%lwhd(i,k,6)*dtf + enddo + enddo + else + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,1) = Diag%dt3dt(i,k,1) + Radtend%htrlw(i,k)*dtf + Diag%dt3dt(i,k,2) = Diag%dt3dt(i,k,2) + Radtend%htrsw(i,k)*dtf*xmu(i) + enddo + enddo + endif + endif + endif ! end if_lssav_block + + do i=1,im + kcnv(i) = 0 + kinver(i) = levs + invrsn(i) = .false. + tx1(i) = zero + tx2(i) = 10.0_kind_phys + ctei_r(i) = 10.0_kind_phys + enddo + +! Only used for old shallow convection with mstrat=.true. + + if ((((Model%imfshalcnv == 0 .and. Model%shal_cnv) .or. Model%old_monin) & + .and. Model%mstrat) .or. Model%do_shoc) then + ctei_rml(:) = Model%ctei_rm(1)*work1(:) + Model%ctei_rm(2)*work2(:) + do k=1,levs/2 + do i=1,im + if (Statein%prsi(i,1)-Statein%prsi(i,k+1) < 0.35_kind_phys*Statein%prsi(i,1) & + .and. (.not. invrsn(i))) then + tem = (Statein%tgrs(i,k+1) - Statein%tgrs(i,k)) & + / (Statein%prsl(i,k) - Statein%prsl(i,k+1)) + + if (((tem > 0.00010_kind_phys) .and. (tx1(i) < zero)) .or. & + ((tem-abs(tx1(i)) > zero) .and. (tx2(i) < zero))) then + invrsn(i) = .true. + + if (Statein%qgrs(i,k,1) > Statein%qgrs(i,k+1,1)) then + tem1 = Statein%tgrs(i,k+1) + hocp*max(Statein%qgrs(i,k+1,1),qmin) + tem2 = Statein%tgrs(i,k) + hocp*max(Statein%qgrs(i,k,1),qmin) + + tem1 = tem1 / Statein%prslk(i,k+1) - tem2 / Statein%prslk(i,k) + +! --- ... (cp/l)(deltathetae)/(deltatwater) > ctei_rm -> conditon for CTEI + ctei_r(i) = (one/hocp)*tem1/(Statein%qgrs(i,k+1,1)-Statein%qgrs(i,k,1) & + + Statein%qgrs(i,k+1,ntcw)-Statein%qgrs(i,k,ntcw)) + else + ctei_r(i) = 10.0_kind_phys + endif + + if ( ctei_rml(i) > ctei_r(i) ) then + kinver(i) = k + else + kinver(i) = levs + endif + endif + + tx2(i) = tx1(i) + tx1(i) = tem + endif + enddo + enddo + endif + +! --- ... lu: initialize flag_guess, flag_iter, tsurf + + do i=1,im +! tsurf(i) = Sfcprop%tsfc(i) + flag_guess(i) = .false. + flag_iter(i) = .true. + drain(i) = zero + ep1d(i) = zero + gflx(i) = zero + runof(i) = zero + hflx(i) = zero + evap(i) = zero + evbs(i) = zero + evcw(i) = zero + trans(i) = zero + sbsno(i) = zero + snowc(i) = zero + snohf(i) = zero + Diag%zlvl(i) = Statein%phil(i,1) * onebg + Diag%smcwlt2(i) = zero + Diag%smcref2(i) = zero + wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & + Statein%vgrs(i,1)*Statein%vgrs(i,1)) & + + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0_kind_phys)), one) + enddo + +! --- ... lu: iter-loop over (sfc_diff,sfc_drv,sfc_ocean,sfc_sice) + do iter=1,2 + +! --- ... surface exchange coefficients +! +! if (lprnt) write(0,*)' tsfc=',Sfcprop%tsfc(ipr),'iter=', & +! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& +! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:) + + call sfc_diff & +! --- inputs: + (im, Statein%pgr, & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), Diag%zlvl, wind, & + Statein%prsl(:,1), work3, & + sigmaf, vegtype, Sfcprop%shdmax, Model%ivegsrc, & + z01d, zt1d, & ! mg, sfc-perts + flag_iter, Model%redrag, & + Diag%u10m, Diag%v10m, Model%sfc_z0_type, & + wet, dry, icy, tsfc3, tsurf3, snowd3, & +! --- input/output: + zorl3, Sfcprop%zorlw, uustar3, & +! --- outputs: + cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23) +! cd3, cdq3, rb3, stress3, ffmm3, ffhh3, fm103, fh23, wind, lprnt, ipr) +! +! if (lprnt) write(0,*)' aft sfc_diff cd3=',cd3(ipr,:),' cdq3=',cdq3(ipr,:),'iter=', iter, & +! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:) +! --- ... lu: update flag_guess + do i=1,im + if (iter == 1 .and. wind(i) < 2.0_kind_phys) then + flag_guess(i) = .true. + endif + enddo + if (Model%nstf_name(1) > 0) then + do i=1,im + if (wet(i)) then +! tem = (Sfcprop%oro(i)-Sfcprop%oro_uf(i)) * rlapse + tem = zero + tseal(i) = tsfc3(i,3) + tem + tsurf3(i,3) = tsurf3(i,3) + tem + endif + enddo + if (Model%cplflx) then ! apply only at ocean points + call get_dtzm_2d (Sfcprop%xt, Sfcprop%xz, Sfcprop%dt_cool, & + Sfcprop%z_c, wet, zero, omz1, im, 1, dtzm) + do i=1,im + if (wet(i) .and. Sfcprop%oceanfrac(i) > zero) then + Sfcprop%tref(i) = Sfcprop%tsfco(i) - dtzm(i) ! update Tf with T1 and NSST T-Profile + if (abs(Sfcprop%xz(i)) > zero) then + tem2 = one / Sfcprop%xz(i) + else + tem2 = zero + endif + tseal(i) = Sfcprop%tref(i) + (Sfcprop%xt(i)+Sfcprop%xt(i)) * tem2 & + - Sfcprop%dt_cool(i) + tsurf3(i,3) = tseal(i) + endif + enddo + endif + +! if (lprnt) write(0,*)' bef nst tseal=',tseal(ipr) & +! ,' tsfc3=',tsfc3(ipr,3),' tsurf3=',tsurf3(ipr,3), & +! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& +! ' tref=',Sfcprop%tref(ipr),' tgrs=',Statein%tgrs(ipr,1),' qgrs=',Statein%qgrs(ipr,1,1), & +! ' prsl=',Statein%prsl(ipr,1),' cd3=',cd3(ipr,3),' cdq3=',cdq3(ipr,3),' work3=', & +! work3(ipr),' semis3=',semis3(ipr,3),' gabsbdlw3=',gabsbdlw3(ipr,3),' adjsfcnsw=', & +! adjsfcnsw(ipr),' wind=',wind(ipr),' tseal=',tseal(ipr),' xcosz=',xcosz(ipr) + + call sfc_nst & +! --- inputs: + (im, Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), & + Sfcprop%tref, cd3(:,3), cdq3(:,3), Statein%prsl(:,1), & + work3, wet, Grid%xlon, Grid%sinlat, stress3(:,3), & + semis3(:,3), gabsbdlw3(:,3), adjsfcnsw, tprcp3(:,3), & + dtf, kdt, Model%solhr, xcosz, & + wind, flag_iter, & + flag_guess, Model%nstf_name, lprnt, ipr, & +! --- input/output + tseal, tsurf3(:,3), Sfcprop%xt, Sfcprop%xs, & + Sfcprop%xu, Sfcprop%xv, Sfcprop%xz, Sfcprop%zm, & + Sfcprop%xtts,Sfcprop%xzts, Sfcprop%dt_cool, & + Sfcprop%z_c, Sfcprop%c_0, Sfcprop%c_d, & + Sfcprop%w_0, Sfcprop%w_d, Sfcprop%d_conv, & + Sfcprop%ifd, Sfcprop%qrain, & +! --- outputs: + qss3(:,3), gflx3(:,3), cmm3(:,3), chh3(:,3), evap3(:,3), & + hflx3(:,3), ep1d3(:,3)) + +! do i=1,im +!! if (wet(i) .and. .not.icy(i)) then +!! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then +! if (wet(i)) then +! tsurf3(i,3) = tsurf3(i,3) & +! - (Sfcprop%oro(i)-Sfcprop%oro_uf(i)) * rlapse +! endif +! enddo + +! --- ... run nsst model ... --- + + if (Model%nstf_name(1) > 1) then + zsea1 = 0.001_kind_phys*real(Model%nstf_name(4)) + zsea2 = 0.001_kind_phys*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) + do i=1,im +! if (wet(i) .and. .not.icy(i)) then +! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then + if (wet(i)) then + tsfc3(i,3) = max(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 + enddo + endif + +! if (lprnt) write(0,*)' aft nst tref=',Sfcprop%tref(ipr) & +! ,' tsfc3=',tsfc3(ipr,3),' dtzm=',dtzm(ipr),' hflx33=',hflx3(ipr,3) +! if (lprnt) print *,' tseaz2=',Sfcprop%tsfc(ipr),' tref=',tref(ipr), & +! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt + + else + +! --- ... surface energy balance over ocean + call sfc_ocean & +! --- inputs: + (im, Statein%pgr, & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), tsfc3(:,3), & + cd3(:,3), cdq3(:,3), Statein%prsl(:,1), work3, wet, & + wind, flag_iter, & +! --- outputs: + qss3(:,3), cmm3(:,3), chh3(:,3), gflx3(:,3), evap3(:,3), & + hflx3(:,3), ep1d3(:,3)) + + endif ! if nstf_name(1) > 0 + +! if (lprnt) write(0,*)' sfalb=',Radtend%sfalb(ipr),' ipr=',ipr & +! , ' weasd=',Sfcprop%weasd(ipr) & +! , ' tprcp=',Sfcprop%tprcp(ipr),' kdt=',kdt,' iter=',iter & +! ,' tseabefland=',Sfcprop%tsfc(ipr) + +! --- ... surface energy balance over land +! + if (Model%lsm == Model%lsm_noah) then ! noah lsm call + +! if (lprnt) write(0,*)' tseal=',tseal(ipr),' tsurf=',tsurf(ipr),iter & +! ,' stsoil0=',stsoil(ipr,:) +! &,' pgr=',pgr(ipr),' sfcemis=',sfcemis(ipr) + + + call sfc_drv & +! --- inputs: + (im, lsoil, Statein%pgr, & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), soiltyp, vegtype, & + sigmaf, semis3(:,1), gabsbdlw3(:,1), adjsfcdsw, adjsfcnsw, dtf,& +! sigmaf, Radtend%semis, gabsbdlw, adjsfcdsw, adjsfcnsw, dtf, & + Sfcprop%tg3, cd3(:,1), cdq3(:,1), Statein%prsl(:,1), work3, & + Diag%zlvl, dry, wind, slopetyp, & + Sfcprop%shdmin, Sfcprop%shdmax, Sfcprop%snoalb, & + Radtend%sfalb, flag_iter, flag_guess, Model%lheatstrg, & + Model%isot, Model%ivegsrc, & + bexp1d, xlai1d, vegf1d,lndp_vgf, & + +! --- input/output: + weasd3(:,1), snowd3(:,1), tsfc3(:,1), tprcp3(:,1), & + Sfcprop%srflag, smsoil, stsoil, slsoil, Sfcprop%canopy, & + trans, tsurf3(:,1), zorl3(:,1), & +! --- outputs: + Sfcprop%sncovr, qss3(:,1), gflx3(:,1), drain, evap3(:,1), & + hflx3(:,1), ep1d3(:,1), runof, & + cmm3(:,1), chh3(:,1), evbs, evcw, sbsno, snowc, Diag%soilm, & + snohf, Diag%smcwlt2, Diag%smcref2, Diag%wet1) + +! if (lprnt) write(0,*)' tseae=',tseal(ipr),' tsurf=',tsurf(ipr),iter +! ,' phy_f2d=',phy_f2d(ipr,num_p2d) + +! if (lprnt) write(0,*)' hflx3=',hflx3(ipr,:),' evap3=',evap3(ipr,:) + +! Noah MP call +! + elseif (Model%lsm == Model%lsm_noahmp) then + call noahmpdrv & +! --- inputs: + (im, lsoil,kdt, Statein%pgr, Statein%ugrs, Statein%vgrs, & + Statein%tgrs, Statein%qgrs, soiltyp, vegtype, sigmaf, & + semis3(:,1), gabsbdlw3(:,1), adjsfcdsw, adjsfcnsw, dtf, & +! Radtend%semis, gabsbdlw, adjsfcdsw, adjsfcnsw, dtf, & + Sfcprop%tg3, cd3(:,1), cdq3(:,1), Statein%prsl(:,1), work3,& + Diag%zlvl, dry, wind, slopetyp, & + Sfcprop%shdmin, Sfcprop%shdmax, Sfcprop%snoalb, & + Radtend%sfalb, flag_iter, flag_guess, & + Model%iopt_dveg, Model%iopt_crs, Model%iopt_btr, & + Model%iopt_run, Model%iopt_sfc, Model%iopt_frz, & + Model%iopt_inf, Model%iopt_rad, Model%iopt_alb, & + Model%iopt_snf, Model%iopt_tbot, Model%iopt_stc, & + grid%xlat, xcosz, Model%yearlen, Model%julian, Model%imn,& + Sfcprop%drainncprv, Sfcprop%draincprv, Sfcprop%dsnowprv, & + Sfcprop%dgraupelprv, Sfcprop%diceprv, & +! --- in/outs: + weasd3(:,1), snowd3(:,1), tsfc3(:,1), tprcp3(:,1), & + Sfcprop%srflag, smsoil, stsoil, slsoil, Sfcprop%canopy, & + trans, tsurf3(:,1), zorl3(:,1), & +! + Sfcprop%snowxy, Sfcprop%tvxy, Sfcprop%tgxy, Sfcprop%canicexy, & + Sfcprop%canliqxy, Sfcprop%eahxy, Sfcprop%tahxy, Sfcprop%cmxy, & + Sfcprop%chxy, Sfcprop%fwetxy, Sfcprop%sneqvoxy, & + Sfcprop%alboldxy, Sfcprop%qsnowxy, Sfcprop%wslakexy, & + Sfcprop%zwtxy, Sfcprop%waxy, Sfcprop%wtxy, Sfcprop%tsnoxy, & + Sfcprop%zsnsoxy, Sfcprop%snicexy, Sfcprop%snliqxy, & + Sfcprop%lfmassxy, Sfcprop%rtmassxy, & + Sfcprop%stmassxy, Sfcprop%woodxy, Sfcprop%stblcpxy, & + Sfcprop%fastcpxy, Sfcprop%xlaixy, Sfcprop%xsaixy, & + Sfcprop%taussxy, Sfcprop%smoiseq, Sfcprop%smcwtdxy, & + Sfcprop%deeprechxy, Sfcprop%rechxy, & +! --- outputs: + Sfcprop%sncovr, qss3(:,1), gflx3(:,1), drain, evap3(:,1), & + hflx3(:,1), ep1d3(:,1), runof, & + cmm3(:,1), chh3(:,1), evbs, evcw, sbsno, snowc, Diag%soilm, & + snohf, Diag%smcwlt2, Diag%smcref2, Diag%wet1, t2mmp, q2mp) + +! if (lprnt) write(0,*)' tseae=',tsea(ipr),' tsurf=',tsurf(ipr),iter & +! &,' phy_f2d=',phy_f2d(ipr,num_p2d) + + elseif (Model%lsm == Model%lsm_ruc) then + write (0,*) 'RUC LSM is available only in CCPP' + stop + + endif !lsm + + !! Strictly speaking, this is not required. But when + !! hunting for bit-for-bit differences, updating the + !! subsurface variables in the Sfcprop DDT makes + !! life a lot easier + !if (Model%frac_grid) then + ! do k=1,lsoil + ! do i=1,im + ! if (dry(i)) then + ! Sfcprop%smc(i,k) = smsoil(i,k) + ! Sfcprop%stc(i,k) = stsoil(i,k) + ! Sfcprop%slc(i,k) = slsoil(i,k) + ! endif + ! enddo + ! enddo + !else + ! do k=1,lsoil + ! do i=1,im + ! Sfcprop%smc(i,k) = smsoil(i,k) + ! Sfcprop%stc(i,k) = stsoil(i,k) + ! Sfcprop%slc(i,k) = slsoil(i,k) + ! enddo + ! enddo + !endif + +! if (lprnt) write(0,*)' tseabeficemodel =',Sfcprop%tsfc(ipr),' me=',me & +! &, ' kdt=',kdt,' tsfc32=',tsfc3(ipr,2),' fice=',fice(ipr) & +! &,' stsoil=',stsoil(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) + +! --- ... surface energy balance over seaice + if (Model%cplflx) then + do i=1,im + if (flag_cice(i)) then + islmsk(i) = islmsk_cice(i) + endif + enddo + +! call sfc_cice for sea ice points in the coupled model (i.e. islmsk=4) +! + call sfc_cice & +! --- inputs: + (im, Statein%tgrs(:,1), & + Statein%qgrs(:,1,1), cd3(:,2), cdq3(:,2), & + Statein%prsl(:,1), wind, & + flag_cice, flag_iter, & + Coupling%dqsfcin_cpl, Coupling%dtsfcin_cpl, & + Coupling%dusfcin_cpl, Coupling%dvsfcin_cpl, & + Coupling%hsnoin_cpl, & +! --- outputs: + qss3(:,2), cmm3(:,2), chh3(:,2), evap3(:,2), hflx3(:,2), & + stress3(:,2), weasd3(:,2), snowd3(:,2), ep1d3(:,2)) + endif +! +! call sfc_sice for lake ice and for the uncoupled case, sea ice (i.e. islmsk=2) +! +! if (Model%frac_grid) then +! do i=1,im +! if (icy(i) .and. islmsk(i) < 2) then +! if (Sfcprop%oceanfrac(i) > zero) then +! tem = Model%min_seaice +! if (fice(i) >= Model%min_seaice) then +! islmsk(i) = 4 +! tice(i) = min(Sfcprop%tisfc(i), tgice) +! endif +! else +! if (fice(i) >= Model%min_lakeice) then +! islmsk(i) = 2 +! tice(i) = min(Sfcprop%tisfc(i), tgice) +! endif +! endif +! endif +! enddo +! endif + call sfc_sice & +! --- inputs: + (im, lsoil, Statein%pgr, & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), dtf, semis3(:,2), & +! Statein%tgrs(:,1), Statein%qgrs(:,1,1), dtf, Radtend%semis, & + gabsbdlw3(:,2), adjsfcnsw, adjsfcdsw, Sfcprop%srflag, & + cd3(:,2), cdq3(:,2), & + Statein%prsl(:,1), work3, islmsk, wind, & + flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & + Sfcprop%oceanfrac, & +! --- input/output: + zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & + stsoil, ep1d3(:,2), & +! --- outputs: + snowd3(:,2), qss3(:,2), snowmt, gflx3(:,2), cmm3(:,2), chh3(:,2), & + evap3(:,2), hflx3(:,2)) + if (Model%frac_grid) then + do i = 1, im + if (islmsk(i) == 2 .and. fice(i) < one) then + wet(i) = .true. + tsfc3(i,3) = max(Sfcprop%tisfc(i), tgice) + endif + enddo + endif + if (Model%cplflx) then + do i = 1, im + if (flag_cice(i)) then + islmsk(i) = nint(Sfcprop%slmsk(i)) + endif + enddo + endif + +! if (lprnt) write(0,*)' tseaafticemodel =',tsfc3(ipr,:),' me=',me & +! &, ' kdt=',kdt,' iter=',iter,' fice=',fice(ipr),' wet=',wet(ipr),' icy=',icy(ipr)& +! &,' dry=',dry(ipr) + +! --- ... lu: update flag_iter and flag_guess + do i=1,im + flag_iter(i) = .false. + flag_guess(i) = .false. + + if (iter == 1 .and. wind(i) < 2.0_kind_phys) then +! if (dry(i) .or. (wet(i) .and. .not.icy(i) & + if (dry(i) .or. (wet(i) .and. Model%nstf_name(1) > 0)) then + flag_iter(i) = .true. + endif + endif + + enddo + + enddo ! end iter_loop + + +! --- generate ocean/land/ice composites + + if (Model%frac_grid) then + do i=1, im +! +! Three-way composites (fields from sfc_diff) + txl = frland(i) + txi = fice(i)*(one - frland(i)) ! txi = ice fraction wrt whole cell + txo = max(zero, one - txl - txi) + +! if (i == ipr .and. lprnt) write(0,*)' txl=',txl,' fice=',fice(i),' txi=',txi,& +! ' txo=',txo,' dry=',dry(i),' wet=',wet(i),' icy=',icy(i),' oceanfrac=',& +! Sfcprop%oceanfrac(i),' frland=',frland(i) + + Sfcprop%zorl(i) = txl*zorl3(i,1) + txi*zorl3(i,2) + txo*zorl3(i,3) + cd(i) = txl*cd3(i,1) + txi*cd3(i,2) + txo*cd3(i,3) + cdq(i) = txl*cdq3(i,1) + txi*cdq3(i,2) + txo*cdq3(i,3) + rb(i) = txl*rb3(i,1) + txi*rb3(i,2) + txo*rb3(i,3) + stress(i) = txl*stress3(i,1) + txi*stress3(i,2) + txo*stress3(i,3) + Sfcprop%ffmm(i) = txl*ffmm3(i,1) + txi*ffmm3(i,2) + txo*ffmm3(i,3) + Sfcprop%ffhh(i) = txl*ffhh3(i,1) + txi*ffhh3(i,2) + txo*ffhh3(i,3) + Sfcprop%uustar(i) = txl*uustar3(i,1) + txi*uustar3(i,2) + txo*uustar3(i,3) + fm10(i) = txl*fm103(i,1) + txi*fm103(i,2) + txo*fm103(i,3) + fh2(i) = txl*fh23(i,1) + txi*fh23(i,2) + txo*fh23(i,3) +! tsurf(i) = txl*tsurf3(i,1) + txi*tice(i) + txo*tsurf3(i,3) +! tsurf(i) = txl*tsurf3(i,1) + txi*tsurf3(i,2) + txo*tsurf3(i,3) ! not used again! Moorthi + 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) +! gflx(i) = txl*gflx3(i,1) + txi*gflx3(i,2) + txo*gflx3(i,3) + ep1d(i) = txl*ep1d3(i,1) + txi*ep1d3(i,2) + txo*ep1d3(i,3) +! Sfcprop%weasd(i) = txl*weasd3(i,1) + txi*weasd3(i,2) + txo*weasd3(i,3) +! Sfcprop%snowd(i) = txl*snowd3(i,1) + txi*snowd3(i,2) + txo*snowd3(i,3) + Sfcprop%weasd(i) = txl*weasd3(i,1) + txi*weasd3(i,2) + Sfcprop%snowd(i) = txl*snowd3(i,1) + txi*snowd3(i,2) +! Sfcprop%tprcp(i) = txl*tprcp3(i,1) + txi*tprcp3(i,2) + txo*tprcp3(i,3) + + if (.not. flag_cice(i) .and. islmsk(i) == 2) then + tem = one - txl + evap(i) = txl*evap3(i,1) + tem*evap3(i,2) + hflx(i) = txl*hflx3(i,1) + tem*hflx3(i,2) + qss(i) = txl*qss3(i,1) + tem*qss3(i,2) + gflx(i) = txl*gflx3(i,1) + tem*gflx3(i,2) + else + evap(i) = txl*evap3(i,1) + txi*evap3(i,2) + txo*evap3(i,3) + hflx(i) = txl*hflx3(i,1) + txi*hflx3(i,2) + txo*hflx3(i,3) + qss(i) = txl*qss3(i,1) + txi*qss3(i,2) + txo*qss3(i,3) + gflx(i) = txl*gflx3(i,1) + txi*gflx3(i,2) + txo*gflx3(i,3) + endif + 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) + +! if (i == ipr .and. lprnt) then +! write(0,*)' tsfc=',Sfcprop%tsfc(i),' txl=',txl,' txi=',txi,' txo=',txo, & +! ' tsfc3=',tsfc3(i,:),' evap3=',evap3(i,:),' evap=',evap(i),' tice=',tice(i),& +! 'Sfcprop%zorl=',Sfcprop%zorl(ipr) +! endif + +! 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%zorli(i) = zorl3(i,2) + Sfcprop%zorlo(i) = zorl3(i,3) + + if (dry(i)) then + Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land + elseif (wet(i)) then + Sfcprop%tsfcl(i) = tsfc3(i,3) ! over land + else + Sfcprop%tsfcl(i) = tice(i) ! over land + endif + if (wet(i)) then + Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake or ocean when uncoupled + elseif (icy(i)) then + Sfcprop%tsfco(i) = tice(i) ! over lake or ocean when uncoupled + else + Sfcprop%tsfco(i) = tsfc3(i,1) ! over lake or ocean when uncoupled + endif + if (icy(i)) then + Sfcprop%tisfc(i) = tice(i) ! over lake or ocean when uncoupled +! if (Sfcprop%zorll(i) > 1000.0) Sfcprop%zorll(i) = zorl3(i,2) + elseif (wet(i)) then + Sfcprop%tisfc(i) = tsfc3(i,3) ! over lake or ocean when uncoupled + else + Sfcprop%tisfc(i) = tsfc3(i,1) ! over lake or ocean when uncoupled + endif + ! for coupled model ocean will replace this +! if (icy(i)) Sfcprop%tisfc(i) = tsfc3(i,2) ! over ice when uncoupled +! if (icy(i)) Sfcprop%tisfc(i) = tice(i) ! over ice when uncoupled + +! if (wet(i) .and. .not. Model%cplflx) then +! Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake or ocean when uncoupled +! Sfcprop%tisfc(i) = tsfc3(i,2) ! over ice when uncoupled +! endif + + if (.not. flag_cice(i)) then +! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + if (icy(i)) then ! return updated lake ice thickness & concentration to global array + Sfcprop%hice(i) = zice(i) + Sfcprop%fice(i) = fice(i) + Sfcprop%tisfc(i) = tice(i) + else ! this would be over open ocean or land (no ice fraction) + Sfcprop%hice(i) = zero + Sfcprop%fice(i) = zero + Sfcprop%tisfc(i) = Sfcprop%tsfc(i) + endif + endif + enddo + else + do i=1,im + if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then + islmsk(i) = 0 + fice(i) = zero + endif + if (islmsk(i) == 1) then + k = 1 + stress(i) = stress3(i,1) +! Sfcprop%tprcp(i) = tprcp3(i,1) + Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land + Sfcprop%tsfco(i) = tsfc3(i,1) + Sfcprop%tisfc(i) = tsfc3(i,1) + Sfcprop%tsfc(i) = tsfc3(i,1) + elseif (islmsk(i) == 0) then + k = 3 + stress(i) = stress3(i,3) +! Sfcprop%tprcp(i) = tprcp3(i,3) + Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled) + Sfcprop%tisfc(i) = tsfc3(i,3) + Sfcprop%tsfcl(i) = tsfc3(i,3) + Sfcprop%tsfc(i) = tsfc3(i,3) + else + k = 2 + stress(i) = stress3(i,2) +! Sfcprop%tprcp(i) = fice(i)*tprcp3(i,2) + (one-fice(i))*tprcp3(i,3) + Sfcprop%tsfc(i) = tsfc3(i,2) + endif + Sfcprop%zorl(i) = zorl3(i,k) + cd(i) = cd3(i,k) + cdq(i) = cdq3(i,k) + rb(i) = rb3(i,k) + Sfcprop%ffmm(i) = ffmm3(i,k) + Sfcprop%ffhh(i) = ffhh3(i,k) + Sfcprop%uustar(i) = uustar3(i,k) + fm10(i) = fm103(i,k) + fh2(i) = fh23(i,k) +! tsurf(i) = tsurf3(i,k) + Diag%cmm(i) = cmm3(i,k) + Diag%chh(i) = chh3(i,k) + gflx(i) = gflx3(i,k) + ep1d(i) = ep1d3(i,k) + Sfcprop%weasd(i) = weasd3(i,k) + Sfcprop%snowd(i) = snowd3(i,k) + evap(i) = evap3(i,k) + hflx(i) = hflx3(i,k) + qss(i) = qss3(i,k) +! Sfcprop%tsfc(i) = tsfc3(i,k) + + Sfcprop%zorll(i) = zorl3(i,1) + Sfcprop%zorli(i) = zorl3(i,2) + Sfcprop%zorlo(i) = zorl3(i,3) + + if (k == 2) then + if (wet(i)) then + Sfcprop%tsfco(i) = tsfc3(i,3) + endif + if (flag_cice(i)) then + if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice + txi = fice(i) + txo = one - txi + evap(i) = txi * evap3(i,2) + txo * evap3(i,3) + hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) + Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) + stress(i) = txi *stress3(i,2) + txo * stress3(i,3) + qss(i) = txi * qss3(i,2) + txo * qss3(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) + Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + endif + elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array + Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) + Sfcprop%tsfc(i) = tsfc3(i,2) + Sfcprop%hice(i) = zice(i) + Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen + Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3) + else ! this would be over open ocean or land (no ice fraction) + Sfcprop%hice(i) = zero + Sfcprop%fice(i) = zero + Sfcprop%tsfc(i) = Sfcprop%tsfco(i) + Sfcprop%tisfc(i) = Sfcprop%tsfc(i) + icy(i) = .false. + endif + Sfcprop%tsfcl(i) = Sfcprop%tsfc(i) + if (.not. wet(i)) then + Sfcprop%tsfco(i) =Sfcprop%tsfc(i) + endif + endif + do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case +! Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) + Sfcprop%stc(i,k) = stsoil(i,k) + enddo + enddo + endif ! if (Model%frac_grid) + +! --- compositing done + +! if (lprnt) write(0,*) 'tisfc=',Sfcprop%tisfc(ipr),'tice=',tice(ipr),' kdt=',kdt + + do i=1,im + Diag%epi(i) = ep1d(i) + Diag%dlwsfci(i) = adjsfcdlw(i) + Diag%ulwsfci(i) = adjsfculw(i) + Diag%uswsfci(i) = adjsfcdsw(i) - adjsfcnsw(i) + Diag%dswsfci(i) = adjsfcdsw(i) + Diag%gfluxi(i) = gflx(i) + Diag%t1(i) = Statein%tgrs(i,1) + Diag%q1(i) = Statein%qgrs(i,1,1) + Diag%u1(i) = Statein%ugrs(i,1) + Diag%v1(i) = Statein%vgrs(i,1) + enddo + +! --- ... update near surface fields + + call sfc_diag (im, Statein%pgr, Statein%ugrs(:,1), Statein%vgrs(:,1), & + Statein%tgrs(:,1), Statein%qgrs(:,1,1), work3, evap, & + Sfcprop%ffmm, Sfcprop%ffhh, fm10, fh2, Sfcprop%tsfc, qss, & + Sfcprop%f10m, Diag%u10m, Diag%v10m, Sfcprop%t2m, Sfcprop%q2m) + + Tbd%phy_f2d(:,Model%num_p2d) = zero + + if (Model%lsm == Model%lsm_noahmp) then + do i=1,im + if (dry(i)) then + Sfcprop%t2m(i) = t2mmp(i) + Sfcprop%q2m(i) = q2mp(i) + endif + enddo + endif ! if (Model%lsm == Model%lsm_noahmp) +! *DH + + if (Model%cplflx .or. Model%cplwav) then + do i=1,im + Coupling%u10mi_cpl (i) = Diag%u10m(i) + Coupling%v10mi_cpl (i) = Diag%v10m(i) + enddo + endif + + if (Model%cplflx) then + do i=1,im + Coupling%dlwsfci_cpl (i) = adjsfcdlw(i) + Coupling%dswsfci_cpl (i) = adjsfcdsw(i) + Coupling%dlwsfc_cpl (i) = Coupling%dlwsfc_cpl(i) + adjsfcdlw(i)*dtf + Coupling%dswsfc_cpl (i) = Coupling%dswsfc_cpl(i) + adjsfcdsw(i)*dtf + Coupling%dnirbmi_cpl (i) = adjnirbmd(i) + Coupling%dnirdfi_cpl (i) = adjnirdfd(i) + Coupling%dvisbmi_cpl (i) = adjvisbmd(i) + Coupling%dvisdfi_cpl (i) = adjvisdfd(i) + Coupling%dnirbm_cpl (i) = Coupling%dnirbm_cpl(i) + adjnirbmd(i)*dtf + Coupling%dnirdf_cpl (i) = Coupling%dnirdf_cpl(i) + adjnirdfd(i)*dtf + Coupling%dvisbm_cpl (i) = Coupling%dvisbm_cpl(i) + adjvisbmd(i)*dtf + Coupling%dvisdf_cpl (i) = Coupling%dvisdf_cpl(i) + adjvisdfd(i)*dtf + Coupling%nlwsfci_cpl (i) = adjsfcdlw(i) - adjsfculw(i) + if (wet(i)) then + Coupling%nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw3(i,3) + endif + 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%psurfi_cpl (i) = Statein%pgr(i) + enddo + +! --- estimate mean albedo for ocean point without ice cover and apply +! them to net SW heat fluxes + + do i=1,im +! if (Sfcprop%landfrac(i) < one) then ! Not 100% land + if (wet(i)) then ! some open water +! --- compute open water albedo + xcosz_loc = max( zero, min( one, xcosz(i) )) + ocalnirdf_cpl(i) = 0.06_kind_phys + ocalnirbm_cpl(i) = max(albdf, 0.026_kind_phys/(xcosz_loc**1.7_kind_phys+0.065_kind_phys) & + & + 0.15_kind_phys * (xcosz_loc-0.1_kind_phys) * (xcosz_loc-0.5_kind_phys) & + & * (xcosz_loc-one)) + ocalvisdf_cpl(i) = 0.06 + ocalvisbm_cpl(i) = ocalnirbm_cpl(i) + + Coupling%nnirbmi_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl(i)) + Coupling%nnirdfi_cpl(i) = adjnirdfd(i) * (one-ocalnirdf_cpl(i)) + Coupling%nvisbmi_cpl(i) = adjvisbmd(i) * (one-ocalvisbm_cpl(i)) + Coupling%nvisdfi_cpl(i) = adjvisdfd(i) * (one-ocalvisdf_cpl(i)) + else + Coupling%nnirbmi_cpl(i) = adjnirbmd(i) - adjnirbmu(i) + Coupling%nnirdfi_cpl(i) = adjnirdfd(i) - adjnirdfu(i) + Coupling%nvisbmi_cpl(i) = adjvisbmd(i) - adjvisbmu(i) + Coupling%nvisdfi_cpl(i) = adjvisdfd(i) - adjvisdfu(i) + endif + Coupling%nswsfci_cpl(i) = Coupling%nnirbmi_cpl(i) + Coupling%nnirdfi_cpl(i) & + + Coupling%nvisbmi_cpl(i) + Coupling%nvisdfi_cpl(i) + Coupling%nswsfc_cpl(i) = Coupling%nswsfc_cpl(i) + Coupling%nswsfci_cpl(i)*dtf + Coupling%nnirbm_cpl(i) = Coupling%nnirbm_cpl(i) + Coupling%nnirbmi_cpl(i)*dtf + Coupling%nnirdf_cpl(i) = Coupling%nnirdf_cpl(i) + Coupling%nnirdfi_cpl(i)*dtf + Coupling%nvisbm_cpl(i) = Coupling%nvisbm_cpl(i) + Coupling%nvisbmi_cpl(i)*dtf + Coupling%nvisdf_cpl(i) = Coupling%nvisdf_cpl(i) + Coupling%nvisdfi_cpl(i)*dtf + enddo + endif + if (Model%lssav) then + do i=1,im + Diag%gflux(i) = Diag%gflux(i) + gflx(i) * dtf + Diag%evbsa(i) = Diag%evbsa(i) + evbs(i) * dtf + Diag%evcwa(i) = Diag%evcwa(i) + evcw(i) * dtf + Diag%transa(i) = Diag%transa(i) + trans(i) * dtf + Diag%sbsnoa(i) = Diag%sbsnoa(i) + sbsno(i) * dtf + Diag%snowca(i) = Diag%snowca(i) + snowc(i) * dtf + Diag%snohfa(i) = Diag%snohfa(i) + snohf(i) * dtf + Diag%ep(i) = Diag%ep(i) + ep1d(i) * dtf + Diag%tmpmax(i) = max(Diag%tmpmax(i), Sfcprop%t2m(i)) + Diag%tmpmin(i) = min(Diag%tmpmin(i), Sfcprop%t2m(i)) + + Diag%spfhmax(i) = max(Diag%spfhmax(i), Sfcprop%q2m(i)) + Diag%spfhmin(i) = min(Diag%spfhmin(i), Sfcprop%q2m(i)) + enddo + + do i=1, im +! find max wind speed then decompose + tem = sqrt(Diag%u10m(i)*Diag%u10m(i) + Diag%v10m(i)*Diag%v10m(i)) + if (tem > Diag%wind10mmax(i)) then + Diag%wind10mmax(i) = tem + Diag%u10mmax(i) = Diag%u10m(i) + Diag%v10mmax(i) = Diag%v10m(i) + endif + +! Compute dew point, first using vapor pressure + tem = max(Statein%pgr(i) * Sfcprop%q2m(i) / ( con_eps - con_epsm1 * Sfcprop%q2m(i)), qmin) + Diag%dpt2m(i) = 243.5 / ( ( 17.67 / log(tem/611.2) ) - one) + 273.14 + enddo + + endif + +!!!!!!!!!!!!!!!!!Commented by Moorthi on July 18, 2012 !!!!!!!!!!!!!!!!!!! +! do i=1,im +! --- ... compute coefficient of evaporation in evapc +! +! if (evapc(i) > one) evapc(i) = one +! --- ... over snow cover or ice or sea, coef of evap =one +! if (weasd(i) > zero .or. slmsk(i) /= one) evapc(i) = one +! enddo +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! --- ... Boundary Layer and Free atmospheic turbulence parameterization +! +! in order to achieve heat storage within canopy layer, in the canopy heat +! storage parameterization the kinematic sensible and latent heat fluxes +! (hflx & evap) as surface boundary forcings to the pbl scheme are +! reduced as a function of surface roughness +! + do i=1,im + hflxq(i) = hflx(i) + evapq(i) = evap(i) + hffac(i) = one + hefac(i) = one + enddo + if (Model%lheatstrg) then + do i=1,im + tem = 0.01_kind_phys * Sfcprop%zorl(i) ! change unit from cm to m + tem1 = (tem - z0min) / (z0max - z0min) + hffac(i) = Model%z0fac * min(max(tem1, zero), one) + tem = sqrt(Diag%u10m(i)*Diag%u10m(i)+Diag%v10m(i)*Diag%v10m(i)) + tem1 = (tem - u10min) / (u10max - u10min) + tem2 = one - min(max(tem1, zero), one) + hffac(i) = tem2 * hffac(i) + hefac(i) = one + Model%e0fac * hffac(i) + hffac(i) = one + hffac(i) + hflxq(i) = hflx(i) / hffac(i) + evapq(i) = evap(i) / hefac(i) + enddo + endif +! +! if (lprnt) write(0,*)' tsea3=',Sfcprop%tsfc(ipr),' slmsk=',Sfcprop%slmsk(ipr) & +! &, ' kdt=',kdt,' evap=',evapq(ipr) +! if (lprnt) write(0,*)' dtdtb=',(dtdt(ipr,k),k=1,15) + +! do i=1,im +! if (islmsk(i) == 0) then +! oro_land(i) = zero +! else +! oro_land(i) = oro(i) +! endif +! enddo + +! write(0,*)' before monin clstp=',clstp,' kdt=',kdt,' lat=',lat +! if (lprnt) write(0,*)'befmonshoc phii=',Statein%phii(ipr,:) +! if (lprnt) write(0,*)'befmonshoc=',Statein%tgrs(ipr,:) +! if (lprnt) write(0,*)'befmonshocdtdt=',dtdt(ipr,1:10) +! if (lprnt) write(0,*)'befmonshoctkh=',Tbd%phy_f3d(ipr,1:10,ntot3d-1) +! if (lprnt) write(0,*)'befmonshochflx=',hflxq(ipr),' tsea=',Sfcprop%tsfc(ipr),& +! ' evap=',evapq(ipr) +! if (lprnt) write(0,*)'befmonshocq=',Statein%qgrs(ipr,:,1) +! if (lprnt) write(0,*)'befmonice=',Statein%qgrs(ipr,:,ntiw) +! if (lprnt) write(0,*)'befmonwat=',Statein%qgrs(ipr,:,ntcw) +! if (lprnt) write(0,*)'befmonshoctke=',Statein%qgrs(ipr,:,ntke) + +! write(0,*)' before monsho hflx=',hflxq,' me=',me +! write(0,*)' before monsho evap=',evapq,' me=',me + + + if (nvdiff == ntrac .or. Model%do_ysu .or. Model%shinhong) then +! + ntiwx = 0 + + if (Model%do_shoc) then + call moninshoc(ix, im, levs, nvdiff, ntcw, nncl, dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Tbd%phy_f3d(1,1,ntot3d-1), prnum, ntke, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, & + Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc,hflxq,& + evapq,stress, wind, kpbl, Statein%prsi, del, Statein%prsl,& + Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & + lprnt, ipr, me) +! if (lprnt) then +! write(0,*)' aftpbl phii=',Statein%phii(ipr,:) +! 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) + call satmedmfvdif(ix, im, levs, nvdiff, ntcw, ntiw, ntke, & + dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, garea, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) + elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) + call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiw, ntke, & + dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk, snowd3, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & + Model%dspfac, Model%bl_upfr, Model%bl_dnfr) + endif + elseif (Model%hybedmf) then + if (Model%moninq_fac > 0) then + call moninedmf(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac) + else + call moninedmf_hafs(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dqdt,& + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac,islmsk) + endif +! if (lprnt) write(0,*)' dtdtm=',(dtdt(ipr,k),k=1,15) +! if (lprnt) write(0,*)' dqdtm=',(dqdt(ipr,k,1),k=1,15) + !elseif (Model%do_ysu) then + ! if (Model%me==0) then + ! write(0,*) 'Error, ysuvdif only available through CCPP' + ! stop + ! end if + !elseif (Model%shinhong) then + ! if (Model%me==0) then + ! write(0,*) 'Error, shinhongvdif only available through CCPP' + ! stop + ! end if + elseif (.not. Model%old_monin) then + call moninq(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), rb, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq,& + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac, Model%rbcr) + else + if (Model%mstrat) then + call moninp1(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Statein%prsik(1,1), rb, Sfcprop%ffmm, Sfcprop%ffhh, & + Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & + Statein%prsi, del, Statein%prsl, Statein%prslk, & + Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + Model%xkzm_m, Model%xkzm_h) + else + call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dqdt, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Statein%prsik(1,1), rb, Sfcprop%ffmm, Sfcprop%ffhh, & + Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & + Statein%prsi, del, Statein%prsl, Statein%phii, & + Statein%phil, dtp, dusfc1, dvsfc1, dtsfc1, dqsfc1, & + Tbd%hpbl, gamt, gamq, dkt, Model%xkzm_m, Model%xkzm_h) + endif + + endif ! end if_hybedmf + endif ! end if_do_shoc + else +! initialized in GFS_typedefs.F90/interstitial_phys_reset; ntiwx is set in +! GFS_typedef.F90/interstitial_setup_tracers + allocate(vdftra(ix,levs,nvdiff), dvdftra(im,levs,nvdiff)) + dvdftra(:,:,:) = zero + ntiwx = 0 +! + if (imp_physics == Model%imp_physics_wsm6) then +! WSM6 + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 4 + ntiwx = 3 + elseif (imp_physics == Model%imp_physics_thompson) then +! Thompson + if(Model%ltaerosol) then + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntlnc) + vdftra(i,k,5) = Statein%qgrs(i,k,ntinc) + vdftra(i,k,6) = Statein%qgrs(i,k,ntoz) + vdftra(i,k,7) = Statein%qgrs(i,k,ntwa) + vdftra(i,k,8) = Statein%qgrs(i,k,ntia) + enddo + enddo + kk = 8 + ntiwx = 3 + else + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntinc) + vdftra(i,k,5) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 5 + ntiwx = 3 + endif + elseif (imp_physics == Model%imp_physics_mg) then ! MG3/2 + if (ntgl > 0) then ! MG3 + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntrw) + vdftra(i,k,5) = Statein%qgrs(i,k,ntsw) + vdftra(i,k,6) = Statein%qgrs(i,k,ntgl) + vdftra(i,k,7) = Statein%qgrs(i,k,ntlnc) + vdftra(i,k,8) = Statein%qgrs(i,k,ntinc) + vdftra(i,k,9) = Statein%qgrs(i,k,ntrnc) + vdftra(i,k,10) = Statein%qgrs(i,k,ntsnc) + vdftra(i,k,11) = Statein%qgrs(i,k,ntgnc) + vdftra(i,k,12) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 12 + else ! MG2 + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntrw) + vdftra(i,k,5) = Statein%qgrs(i,k,ntsw) + vdftra(i,k,6) = Statein%qgrs(i,k,ntlnc) + vdftra(i,k,7) = Statein%qgrs(i,k,ntinc) + vdftra(i,k,8) = Statein%qgrs(i,k,ntrnc) + vdftra(i,k,9) = Statein%qgrs(i,k,ntsnc) + vdftra(i,k,10) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 10 + endif + ntiwx = 3 +! + elseif (imp_physics == Model%imp_physics_gfdl) then! GFDL MP + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntiw) + vdftra(i,k,4) = Statein%qgrs(i,k,ntrw) + vdftra(i,k,5) = Statein%qgrs(i,k,ntsw) + vdftra(i,k,6) = Statein%qgrs(i,k,ntgl) + vdftra(i,k,7) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 7 + ntiwx = 3 + elseif (imp_physics == Model%imp_physics_zhao_carr) then ! Zhao/Carr/Sundqvist + do k=1,levs + do i=1,im + vdftra(i,k,1) = Statein%qgrs(i,k,1) + vdftra(i,k,2) = Statein%qgrs(i,k,ntcw) + vdftra(i,k,3) = Statein%qgrs(i,k,ntoz) + enddo + enddo + kk = 3 + endif +! + if (trans_aero) then + k1 = kk + do n=Model%ntchs,Model%ntchm+Model%ntchs-1 + k1 = k1 + 1 + do k=1,levs + do i=1,im + vdftra(i,k,k1) = Statein%qgrs(i,k,n) + enddo + enddo + enddo + endif +! + if (ntke > 0) then ! prognostic TKE + ntkev = nvdiff + do k=1,levs + do i=1,im + vdftra(i,k,ntkev) = Statein%qgrs(i,k,ntke) + enddo + enddo + endif +! for SHOC nvdiff=ntrac, so the following is not needed unless cplchm is true +! ----------------------------------------------------- + if (Model%do_shoc) then + call moninshoc(ix, im, levs, nvdiff, ntcw, nncl, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Tbd%phy_f3d(1,1,ntot3d-1), prnum, ntkev, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, & + Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, & + evapq, stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & + lprnt, ipr, me) + else + if (Model%satmedmf) then + if (Model%isatmedmf == 0) then ! initial version of satmedmfvdif (Nov 2018) + call satmedmfvdif(ix, im, levs, nvdiff, ntcw, ntiwx, ntkev, & + dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Radtend%htrsw, Radtend%htrlw, xmu, garea, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) + elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) + call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiwx, ntkev, & + dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Radtend%htrsw, Radtend%htrlw, xmu, garea, islmsk, snowd3, & + Statein%prsik(1,1), rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & + Model%dspfac, Model%bl_upfr, Model%bl_dnfr) + endif + elseif (Model%hybedmf) then + if ( Model%moninq_fac > 0 ) then + call moninedmf(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac) + else + call moninedmf_hafs(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac,islmsk) + endif + elseif (.not. Model%old_monin) then + call moninq(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), rb, & + Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, & + stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & + Model%xkzminv, Model%moninq_fac, Model%rbcr) + else + if (Model%mstrat) then + call moninp1(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Statein%prsik(1,1), rb, Sfcprop%ffmm, Sfcprop%ffhh, & + Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & + Statein%prsi, del, Statein%prsl, Statein%prslk, & + Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + Model%xkzm_m, Model%xkzm_h) + else + call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dvdftra, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, vdftra, & + Statein%prsik(1,1), rb, Sfcprop%ffmm, Sfcprop%ffhh, & + Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & + Statein%prsi, del, Statein%prsl, Statein%phii, & + Statein%phil, dtp, dusfc1, dvsfc1, dtsfc1, dqsfc1, & + Tbd%hpbl, gamt, gamq, dkt, Model%xkzm_m, Model%xkzm_h) + endif + + endif ! end if_satmedmf + endif ! end if_do_shoc + if (ntke > 0) then + do k=1,levs + do i=1,im + dqdt(i,k,ntke) = dvdftra(i,k,ntkev) + enddo + enddo + endif + if (trans_aero) then + k1 = kk + do n=Model%ntchs,Model%ntchm+Model%ntchs-1 + k1 = k1 + 1 + do k=1,levs + do i=1,im + dqdt(i,k,n) = dvdftra(i,k,k1) + enddo + enddo + enddo + endif + if (imp_physics == Model%imp_physics_wsm6) then ! WSM6 + do k=1,levs + do i=1,im + 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,ntoz) = dvdftra(i,k,4) + enddo + enddo + elseif (imp_physics == Model%imp_physics_thompson) then ! Thompson + if(Model%ltaerosol) then + do k=1,levs + do i=1,im + 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,ntlnc) = dvdftra(i,k,4) + dqdt(i,k,ntinc) = dvdftra(i,k,5) + dqdt(i,k,ntoz) = dvdftra(i,k,6) + dqdt(i,k,ntwa) = dvdftra(i,k,7) + dqdt(i,k,ntia) = dvdftra(i,k,8) + enddo + enddo + else + do k=1,levs + do i=1,im + 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,ntinc) = dvdftra(i,k,4) + dqdt(i,k,ntoz) = dvdftra(i,k,5) + enddo + enddo + endif + elseif (imp_physics == Model%imp_physics_mg) then ! MG3/2 + if (ntgl > 0) then ! MG + do k=1,levs + do i=1,im + 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) = 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 +! + elseif (imp_physics == Model%imp_physics_gfdl) then ! GFDL MP + do k=1,levs + do i=1,im + 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,ntoz) = dvdftra(i,k,7) + enddo + enddo + + elseif (imp_physics == Model%imp_physics_zhao_carr) then ! Zhao/Carr/Sundqvist + do k=1,levs + do i=1,im + dqdt(i,k,1) = dvdftra(i,k,1) + dqdt(i,k,ntcw) = dvdftra(i,k,2) + dqdt(i,k,ntoz) = dvdftra(i,k,3) + enddo + enddo + endif +! + deallocate(vdftra, dvdftra) + + endif + + if (Model%cplchm) then + do i = 1, im + tem1 = max(Diag%q1(i), qmin) + tem = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(one+con_fvirt*tem1)) + Coupling%ushfsfci(i) = -con_cp * tem * hflx(i) ! upward sensible heat flux + enddo + Coupling%dkt (:,:) = dkt (:,:) + endif + +! if (lprnt) then +! write(0,*) ' dusfc1=',dusfc1(ipr),' kdt=',kdt +! write(0,*) ' dvsfc1=',dvsfc1(ipr),' kdt=',kdt +! write(0,*)' dtsfc1=',dtsfc1(ipr)*hffac(ipr) +! write(0,*)' dqsfc1=',dqsfc1(ipr)*hefac(ipr) +! write(0,*)' dtdtc=',(dtdt(ipr,k),k=1,15) +! write(0,*)' dqdtc=',(dqdt(ipr,k,1),k=1,15) +! print *,' dudtm=',dudt(ipr,:) +! endif + +! --- ... coupling insertion + + if (Model%cplflx) then + do i=1,im + if (Sfcprop%oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if (Sfcprop%fice(i) > one - epsln) then ! no open water, thus use results from CICE + Coupling%dusfci_cpl(i) = Coupling%dusfcin_cpl(i) + Coupling%dvsfci_cpl(i) = Coupling%dvsfcin_cpl(i) + Coupling%dtsfci_cpl(i) = Coupling%dtsfcin_cpl(i) + Coupling%dqsfci_cpl(i) = Coupling%dqsfcin_cpl(i) + elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + tem1 = max(Diag%q1(i), qmin) + rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(one+con_fvirt*tem1)) + if (wind(i) > zero) then + tem = - rho * stress3(i,3) / wind(i) + Coupling%dusfci_cpl(i) = tem * Statein%ugrs(i,1) ! U-momentum flux + Coupling%dvsfci_cpl(i) = tem * Statein%vgrs(i,1) ! V-momentum flux + else + Coupling%dusfci_cpl(i) = zero + Coupling%dvsfci_cpl(i) = zero + endif + Coupling%dtsfci_cpl(i) = con_cp * rho * hflx3(i,3) ! sensible heat flux over open ocean + Coupling%dqsfci_cpl(i) = con_hvap * rho * evap3(i,3) ! latent heat flux over open ocean + else ! use results from PBL scheme for 100% open ocean + Coupling%dusfci_cpl(i) = dusfc1(i) + Coupling%dvsfci_cpl(i) = dvsfc1(i) + Coupling%dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + Coupling%dqsfci_cpl(i) = dqsfc1(i)*hefac(i) + endif + + Coupling%dusfc_cpl (i) = Coupling%dusfc_cpl(i) + Coupling%dusfci_cpl(i) * dtf + Coupling%dvsfc_cpl (i) = Coupling%dvsfc_cpl(i) + Coupling%dvsfci_cpl(i) * dtf + 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 +!-------------------------------------------------------lssav if loop ---------- + if (Model%lssav) then + do i=1,im + Diag%dusfc (i) = Diag%dusfc(i) + dusfc1(i)*dtf + Diag%dvsfc (i) = Diag%dvsfc(i) + dvsfc1(i)*dtf + Diag%dtsfc (i) = Diag%dtsfc(i) + dtsfc1(i)*hffac(i)*dtf + Diag%dqsfc (i) = Diag%dqsfc(i) + dqsfc1(i)*hefac(i)*dtf + Diag%dusfci(i) = dusfc1(i) + Diag%dvsfci(i) = dvsfc1(i) + Diag%dtsfci(i) = dtsfc1(i)*hffac(i) + Diag%dqsfci(i) = dqsfc1(i)*hefac(i) + enddo +! if (lprnt) then +! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', +! & dtf,' kdt=',kdt,' lat=',lat +! endif + + if (Model%ldiag3d) then + if (Model%lsidea) then + Diag%dt3dt(1:im,:,3) = Diag%dt3dt(1:im,:,3) + dtdt(1:im,:)*dtf + else + do k=1,levs + do i=1,im + tem = dtdt(i,k) - (Radtend%htrlw(i,k)+Radtend%htrsw(i,k)*xmu(i)) + Diag%dt3dt(i,k,3) = Diag%dt3dt(i,k,3) + tem*dtf + enddo + enddo + endif + do k=1,levs + do i=1,im + Diag%du3dt(i,k,1) = Diag%du3dt(i,k,1) + dudt(i,k) * dtf + Diag%du3dt(i,k,2) = Diag%du3dt(i,k,2) - dudt(i,k) * dtf + Diag%dv3dt(i,k,1) = Diag%dv3dt(i,k,1) + dvdt(i,k) * dtf + Diag%dv3dt(i,k,2) = Diag%dv3dt(i,k,2) - dvdt(i,k) * dtf + enddo + enddo + endif + + endif ! end if_lssav + +! + if (ldiag_ugwp) then +! +! here for COORDE-2018 clean way to store averaged du3dt_pbl +! + do k=1,levs + do i=1,im + Diag%du3dt_pbl(i,k) = Diag%du3dt_pbl(i,k) + dUdt(i,k) * fdaily + Diag%dv3dt_pbl(i,k) = Diag%dv3dt_pbl(i,k) + dVdt(i,k) * fdaily + Diag%dt3dt_pbl(i,k) = Diag%dt3dt_pbl(i,k) + dTdt(i,k) * fdaily +! Tdudt(i,k) = Tdudt(i,k) + dUdt(i,k) * fdaily +! Tdvdt(i,k) = Tdvdt(i,k) + dVdt(i,k) * fdaily +! Tdtdt(i,k) = Tdtdt(i,k) + dTdt(i,k) * fdaily + enddo + enddo + endif + + if (Model%lssav) then + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,7) = Diag%dt3dt(i,k,7) - dtdt(i,k)*dtf + enddo + enddo + endif + endif + +!============================================================= GW-physics start +! +! Orographic gravity wave drag parameterization +! --------------------------------------------- + + if (nmtvr == 14) then ! current operational - as of 2014 + do i=1,im +! vay-2018 +! copy to the separate container to avoid "use" of Sfcprop as "static" field +! sgh30 for TOFD +! + sgh30(i) = abs(Sfcprop%oro(i) - Sfcprop%oro_uf(i)) + + oc(i) = Sfcprop%hprime(i,2) + oa4(i,1) = Sfcprop%hprime(i,3) + oa4(i,2) = Sfcprop%hprime(i,4) + oa4(i,3) = Sfcprop%hprime(i,5) + oa4(i,4) = Sfcprop%hprime(i,6) + clx(i,1) = Sfcprop%hprime(i,7) + clx(i,2) = Sfcprop%hprime(i,8) + clx(i,3) = Sfcprop%hprime(i,9) + clx(i,4) = Sfcprop%hprime(i,10) + theta(i) = Sfcprop%hprime(i,11) + gamma(i) = Sfcprop%hprime(i,12) + sigma(i) = Sfcprop%hprime(i,13) + elvmax(i) = Sfcprop%hprime(i,14) + enddo + elseif (nmtvr == 10) then + do i=1,im + oc(i) = Sfcprop%hprime(i,2) + oa4(i,1) = Sfcprop%hprime(i,3) + oa4(i,2) = Sfcprop%hprime(i,4) + oa4(i,3) = Sfcprop%hprime(i,5) + oa4(i,4) = Sfcprop%hprime(i,6) + clx(i,1) = Sfcprop%hprime(i,7) + clx(i,2) = Sfcprop%hprime(i,8) + clx(i,3) = Sfcprop%hprime(i,9) + clx(i,4) = Sfcprop%hprime(i,10) + enddo + elseif (nmtvr == 6) then + do i=1,im + oc(i) = Sfcprop%hprime(i,2) + oa4(i,1) = Sfcprop%hprime(i,3) + oa4(i,2) = Sfcprop%hprime(i,4) + oa4(i,3) = Sfcprop%hprime(i,5) + oa4(i,4) = Sfcprop%hprime(i,6) + clx(i,1) = zero + clx(i,2) = zero + clx(i,3) = zero + clx(i,4) = zero + enddo + else +! +! no-oro effects +! + sgh30(:) = zero + oc = zero ; oa4 = zero ; clx = zero ; theta = zero + gamma = zero ; sigma = zero ; elvmax = zero + + endif ! end if_nmtvr + +! +!===== UGWP-start: two versions V0 (knob_ugwp_version=0) and V1(knob_ugwp_version=1) +! +! + if (Model%do_gwd) then + if (knob_ugwp_version == 1 ) then + if (kdt < 2 .and. me == master) then + print *, ' VAY-attention UGWP-V1 cires_ugwp_driver ' + print *, ' Only Test-mode by developers ' + stop ' cires_ugwp_driver Test-mode Jan 2019 ' + endif + + call cires_ugwp_driver & + (im, levs, dtp, kdt, me, lprnt, Model%lonr, & + Model%prslrd0, Model%ral_ts, Model%cdmbgwd, & + Grid%xlat, Grid%xlat_d, Grid%sinlat, Grid%coslat, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, & + Statein%qgrs(1:im,1:levs,1), Statein%prsi, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, & + del, Sfcprop%hprime, kpbl, & + dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & +!diagnostics + Diag%gwp_ax, Diag%gwp_axo, Diag%gwp_axc, Diag%gwp_axf, & + Diag%gwp_ay, Diag%gwp_ayo, Diag%gwp_ayc, Diag%gwp_ayf, & + Diag%gwp_dtdt, Diag%gwp_kdis, Diag%gwp_okw, Diag%gwp_fgf, & + Diag%gwp_dcheat, Diag%gwp_precip, Diag%gwp_klevs, & + Diag%zmtb, Diag%gwp_scheat, dlength, cldf, & +!COORDE-2019 diagnostics without 3d-fluxes: tauz_ogw, tauz_ngw .... + Diag%tau_tofd, Diag%tau_mtb, Diag%tau_ogw, Diag%tau_ngw, & + Diag%zmtb, Diag%zlwb, Diag%zogw, Diag%du3dt_mtb, & + Diag%du3dt_ogw, Diag%du3dt_tms ) + +! do k=1,levs +! do i=1,im +! Pdtdt(i,k) = gw_dtdt(i,k) +! Pdudt(i,k) = gw_dudt(i,k) +! Pdvdt(i,k) = gw_dvdt(i,k) +! enddo +! enddo + + else +! +!knob_ugwp_version == o +! + if (kdt < 2 .and. me == master) then + print *, ' VAY-attention UGWP-V0, Jan 2019 ' + endif +! + allocate (tke(im,levs)) + if (ntke > 0) then + tke(1:im,:) = Statein%qgrs(1:im,:,ntke) + dqdt(1:im,:,ntke) * dtp + else + tke(:,:) = -9999.0_kind_phys + endif +! +! tendency without PBL-accumulations +! + call cires_ugwp_driver_v0 & + (me, master, im, levs, nmtvr, dtp, kdt, Model%lonr, & + Model%do_ugwp, Model%do_tofd, Model%cdmbgwd, & + Grid%xlat, Grid%xlat_d, & + Grid%sinlat, Grid%coslat, Grid%area, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs(1,1,1),& + Statein%prsi, Statein%prsl, Statein%prslk, Statein%phii, & + Statein%phil, del, Sfcprop%hprime(:,1), oc, oa4, clx, theta, & + gamma, sigma, elvmax, sgh30, kpbl, & + dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + tau_tms, tau_mtb, tau_ogw, tau_ngw, & + zm_mtb, zm_lwb, zm_ogw, ax_mtb, ax_ogw, ax_tms, & + Diag%zmtnblck, Diag%rain, ntke, tke, lprnt, ipr) + + +!Diag for COORDE-2019....... for cires_ugwp_driver_v0 + + if (ldiag_ugwp) then + do i=1,im + Diag%zmtb(i) = Diag%zmtb(i) + fdaily * zm_mtb(i) + Diag%zlwb(i) = Diag%zlwb(i) + fdaily * zm_lwb(i) + Diag%zogw(i) = Diag%zogw(i) + fdaily * zm_ogw(i) + Diag%tau_tofd(i) = Diag%tau_tofd(i) + fdaily * tau_tms(i) + Diag%tau_mtb(i) = Diag%tau_mtb(i) + fdaily * tau_mtb(i) + Diag%tau_ogw(i) = Diag%tau_ogw(i) + fdaily * tau_ogw(i) + Diag%tau_ngw(i) = Diag%tau_ngw(i) + fdaily * tau_ngw(i) + enddo + do k=1,levs + do i=1,im + Diag%du3dt_mtb(i,k) = Diag%du3dt_mtb(i,k) + fdaily * ax_mtb(i,k) + Diag%du3dt_tms(i,k) = Diag%du3dt_tms(i,k) + fdaily * ax_tms(i,k) + Diag%du3dt_ogw(i,k) = Diag%du3dt_ogw(i,k) + fdaily * ax_ogw(i,k) + Diag%du3dt_ngw(i,k) = Diag%du3dt_ngw(i,k) + fdaily * gw_dudt(i,k) + Diag%dv3dt_ngw(i,k) = Diag%dv3dt_ngw(i,k) + fdaily * gw_dvdt(i,k) + +! Tdudt(i,k) = Tdudt(i,k) + gw_dudt(i,k)* fdaily +! Tdvdt(i,k) = Tdvdt(i,k) + gw_dvdt(i,k)* fdaily +! Tdtdt(i,k) = Tdtdt(i,k) + gw_dvdt(i,k)* fdaily + enddo + enddo + endif +! + do k=1,levs + do i=1,im + dtdt(i,k) = dtdt(i,k) + gw_dtdt(i,k) + dudt(i,k) = dudt(i,k) + gw_dudt(i,k) + dvdt(i,k) = dvdt(i,k) + gw_dvdt(i,k) + enddo + enddo + + endif ! if (knob_ugwp_version == 1 ) then + endif ! if (do_gwd) then + +! +!===== UGWP-end ===== ===== ===== +! + + if (Model%lssav) then + do i=1,im + Diag%dugwd(i) = Diag%dugwd(i) + dusfcg(i)*dtf + Diag%dvgwd(i) = Diag%dvgwd(i) + dvsfcg(i)*dtf + enddo + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%du3dt(i,k,2) = Diag%du3dt(i,k,2) + dudt(i,k) * dtf + Diag%dv3dt(i,k,2) = Diag%dv3dt(i,k,2) + dvdt(i,k) * dtf + Diag%dt3dt(i,k,7) = Diag%dt3dt(i,k,7) + dtdt(i,k) * dtf + enddo + enddo + endif + endif + +! +!=============================================== +! +!! if (ldiag_ugwp) then +!! do k=1,levs +!! do i=1,im +!! Tdudt(i,k) = Tdudt(i,k) + PdUdt(i,k) * fdaily +!! Tdvdt(i,k) = Tdvdt(i,k) + PdVdt(i,k) * fdaily +!! Tdtdt(i,k) = Tdtdt(i,k) + PdTdt(i,k) * fdaily +! +!! enddo +!! enddo +!! endif + +! Rayleigh damping near the model top + if( .not. Model%lsidea .and. Model%ral_ts > zero) then + call rayleigh_damp(im, ix, im, levs, dvdt, dudt, dtdt, & + Statein%ugrs, Statein%vgrs, dtp, con_cp, & + Model%levr, Statein%pgr, Statein%prsl, & + Model%prslrd0, Model%ral_ts) + endif + +! if (lprnt) then +! write(0,*)' tgrs1=',(Statein%tgrs(ipr,k),k=1,10) +! write(0,*)' dtdt=',(dtdt(ipr,k),k=1,10) +! endif + +! Standard accum-Update before "moist physics" by "PBL + GWP + RF" as in GFS/GSM +! + + do k=1,levs + do i=1,im + Stateout%gt0(i,k) = Statein%tgrs(i,k) + dtdt(i,k) * dtp + Stateout%gu0(i,k) = Statein%ugrs(i,k) + dudt(i,k) * dtp + Stateout%gv0(i,k) = Statein%vgrs(i,k) + dvdt(i,k) * dtp + enddo + enddo + Stateout%gq0(1:im,:,:) = Statein%qgrs(1:im,:,:) + dqdt(1:im,:,:) * dtp + +!================================================================================ +! above: updates of the state by UGWP oro-GWS and RF-damp +! Diag%tav_ugwp & Diag%uav_ugwp(i,k)-Updated U-T state before moist/micro ! physics +!================================================================================ + + if (ldiag_ugwp) then + do k=1,levs + do i=1,im + Diag%tav_ugwp(i,k) = Diag%tav_ugwp(i,k) + Stateout%gt0(i,k) * fdaily + Diag%uav_ugwp(i,k) = Diag%uav_ugwp(i,k) + Stateout%gu0(i,k) * fdaily +! Diag%vav_ogw(i,k) = Diag%vav_ogw(i,k) + Stateout%gv0(i,k) * fdaily + enddo + enddo + endif + +!================================================================================ +! It is not clear Do we need it, "ideaca_up", having stability check inside UGWP-module + if (Model%lsidea) then ! idea convective adjustment + call ideaca_up(Statein%prsi,Stateout%gt0,ix,im,levs+1) + endif + +! --- ... ozone physics + + if (ntoz > 0 .and. ntrac >= ntoz) then + if (oz_coeff > 4) then + call ozphys_2015 (ix, im, levs, levozp, dtp, & + Stateout%gq0(1,1,ntoz), & + Stateout%gq0(1,1,ntoz), & + Stateout%gt0, oz_pres, Statein%prsl, & + Tbd%ozpl, oz_coeff, del, Model%ldiag3d, & + dq3dt_loc(1,1,6), me) +! if (Model%ldiag3d) then +! do k=1,levs +! do i=1,im +! Diag%dq3dt(i,k,6) = dq3dt_loc(i,k,6) +! Diag%dq3dt(i,k,7) = dq3dt_loc(i,k,7) +! Diag%dq3dt(i,k,8) = dq3dt_loc(i,k,8) +! Diag%dq3dt(i,k,9) = dq3dt_loc(i,k,9) +! enddo +! enddo +! endif + else + call ozphys (ix, im, levs, levozp, dtp, & + Stateout%gq0(1,1,ntoz), & + Stateout%gq0(1,1,ntoz), & + Stateout%gt0, oz_pres, Statein%prsl, & + Tbd%ozpl, oz_coeff, del, Model%ldiag3d, & + dq3dt_loc(1,1,6), me) +! if (Model%ldiag3d) then +! do k=1,levs +! do i=1,im +! Diag%dq3dt(i,k,6) = dq3dt_loc(i,k,6) +! Diag%dq3dt(i,k,7) = dq3dt_loc(i,k,7) +! Diag%dq3dt(i,k,8) = dq3dt_loc(i,k,8) +! Diag%dq3dt(i,k,9) = dq3dt_loc(i,k,9) +! enddo +! enddo +! endif + endif + endif + + if (Model%h2o_phys) then + call h2ophys (ix, im, levs, levh2o, dtp, Stateout%gq0(1,1,1), & + Stateout%gq0(1,1,1), h2o_pres, Statein%prsl, & + Tbd%h2opl, h2o_coeff, Model%ldiag3d, & + dq3dt_loc(1,1,1), me) + endif + +! --- ... to side-step the ozone physics + +! if (ntrac >= 2) then +! do k = 1, levs +! gq0(k,ntoz) = qgrs(k,ntoz) +! enddo +! endif + +! if (lprnt) then +! write(0,*) ' levs=',levs,' jcap=',jcap,' dtp',dtp & +! &, ' slmsk=',slmsk(ilon,ilat),' kdt=',kdt +! print *,' rann=',rann,' ncld=',ncld,' iq=',iq,' lat=',lat +! print *,' pgr=',pgr +! print *,' del=',del(ipr,:) +! print *,' prsl=',prsl(ipr,:) +! print *,' prslk=',prslk(ipr,:) +! print *,' rann=',rann(ipr,1) +! write(0,*)' gt0=',Stateout%gt0(ipr,:) & +! &, ' kdt=',kdt,' xlon=',grid%xlon(ipr),' xlat=',grid%xlat(ipr) +! print *,' dtdt=',dtdt(ipr,:) +! print *,' gu0=',gu0(ipr,:) +! print *,' gv0=',gv0(ipr,:) +! 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,:) +! &,' lat=',lat,' kdt=',kdt,' me=',me +! if (lprnt) write(7000,*)' bef convection gv0=',gv0(ipr,:) + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + dtdt(i,k) = Stateout%gt0(i,k) + dudt(i,k) = Stateout%gu0(i,k) + dvdt(i,k) = Stateout%gv0(i,k) + enddo + enddo + elseif (Model%do_cnvgwd) then + dtdt(1:im,:) = Stateout%gt0(1:im,:) + endif ! end if_ldiag3d/cnvgwd + + if (Model%ldiag3d .or. Model%cplchm) then + dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1) + endif ! end if_ldiag3d/cplchm + + if (Model%cplchm) then + Coupling%dqdti(1:im,:) = zero + endif ! end if_cplchm + +#ifdef GFS_HYDRO + call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & + Model%thermodyn_id, Model%sfcpress_id, & + Model%gen_coord_hybrid Statein%prsi, Statein%prsik, & + Statein%prsl, Statein%prslk, Statein%phii, Statein%phil) +#else +! if (lprnt) write(0,*)'bef get_phi_fv3 gt0=',Stateout%gt0(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)'bef get_phi_fv3 gq0=',Stateout%gq0(ipr,:,1),' kdt=',kdt +! if (lprnt) write(0,*)'bef get_phi_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt + +!GFDL Adjust the height hydrostatically in a way consistent with FV3 discretization + call get_phi_fv3 (ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & + del_gz, Statein%phii, Statein%phil) + +! if (lprnt) write(0,*)'aft get_phi_fv3 phii=',Statein%phii(ipr,:),' kdt=',kdt +#endif + +! GFS_typedefs.F90/interstitial_phys_reset + do k=1,levs + do i=1,im + clw(i,k,1) = zero + clw(i,k,2) = -999.9_kind_phys + enddo + enddo + + if(imp_physics == Model%imp_physics_thompson) then + if(Model%ltaerosol) then + ice00 (:,:) = zero + liq0 (:,:) = zero + else + ice00 (:,:) = zero + endif + endif + +! --- ... for convective tracer transport (while using ras, csaw, or samf) +! (the code here implicitly assumes that ntiw=ntcw+1) + + ntk = 0 + tottracer = 0 + if (Model%cscnv .or. Model%satmedmf .or. Model%trans_trac ) then + otspt(:,:) = .true. ! otspt is used only for cscnv + otspt(1:3,:) = .false. ! this is for sp.hum, ice and liquid water + tracers = 2 + 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 + do i=1,im + clw(i,k,tracers) = Stateout%gq0(i,k,n) + enddo + enddo + if (ntke == n ) then + otspt(tracers+1,1) = .false. + ntk = tracers + endif + if (ntlnc == n .or. ntinc == n .or. ntrnc == n .or. ntsnc == n .or. ntgnc == n) & +! if (ntlnc == n .or. ntinc == n .or. ntrnc == n .or. ntsnc == n .or.& +! ntrw == n .or. ntsw == n .or. ntgl == n) & + otspt(tracers+1,1) = .false. + if (trans_aero .and. Model%ntchs == n) itc = tracers + endif + enddo + tottracer = tracers - 2 + endif ! end if_ras or cfscnv or samf + +! if (kdt == 1 .and. me == 0) & +! write(0,*)' trans_trac=',Model%trans_trac,' tottracer=', & +! & tottracer,' kdt=',kdt,' ntk=',ntk + do i=1,im + ktop(i) = 1 + kbot(i) = levs + enddo + +! --- ... calling condensation/precipitation processes +! -------------------------------------------- + if (ntcw > 0) then +! if (imp_physics == Model%imp_physics_mg .and. .not. Model%do_shoc) then ! compute rhc for GMAO macro physics cloud pdf + if (imp_physics == Model%imp_physics_mg .and. Model%crtrh(2) < half) then ! compute rhc for GMAO macro physics cloud pdf + do i=1,im + tx1(i) = one / Statein%prsi(i,1) + tx2(i) = one - rhc_max*work1(i) - Model%crtrh(1)*work2(i) + kk = min(kinver(i), max(2,kpbl(i))) + tx3(i) = Statein%prsi(i,kk)*tx1(i) + tx4(i) = Model%crtrh(2) - Model%crtrh(3)*abs(cos(Grid%xlat(i))) + enddo + do k = 1, levs + do i = 1, im + tem = Statein%prsl(i,k) * tx1(i) + tem1 = min(max((tem-tx3(i))*slope_mg, -20.0_kind_phys), 20.0_kind_phys) +! +! Using crtrh(2) and crtrh(3) from the namelist instead of 0.3 and 0.2 +! and crtrh(1) represents pbl top critical relative humidity + tem2 = min(max((tx4(i)-tem)*slope_upmg, -20.0_kind_phys), 20.0_kind_phys) + + if (islmsk(i) > 0) then + tem1 = one / (one+exp(tem1+tem1)) + else + tem1 = 2.0_kind_phys / (one+exp(tem1+tem1)) + endif + tem2 = one / (one+exp(tem2)) + + rhc(i,k) = min(rhc_max, max(0.7_kind_phys, one-tx2(i)*tem1*tem2)) + enddo + enddo + else + do k=1,levs + do i=1,im + kk = max(10,kpbl(i)) + if (k < kk) then + tem = Model%crtrh(1) - (Model%crtrh(1)-Model%crtrh(2)) & + * (one-Statein%prslk(i,k)) / (one-Statein%prslk(i,kk)) + else + tem = Model%crtrh(2) - (Model%crtrh(2)-Model%crtrh(3)) & + * (Statein%prslk(i,kk)-Statein%prslk(i,k)) / Statein%prslk(i,kk) + endif + if (rhc_max > tem) tem = rhc_max * work1(i) + tem * work2(i) + rhc(i,k) = max(zero, min(one, tem)) + enddo + enddo + endif + endif ! ntcw > 0 +! + if (imp_physics == Model%imp_physics_zhao_carr .or. & + imp_physics == Model%imp_physics_zhao_carr_pdf) then ! zhao-carr microphysics + do i=1,im + psautco_l(i) = Model%psautco(1)*work1(i) + Model%psautco(2)*work2(i) + prautco_l(i) = Model%prautco(1)*work1(i) + Model%prautco(2)*work2(i) + enddo + do k=1,levs + do i=1,im + clw(i,k,1) = Stateout%gq0(i,k,ntcw) + enddo + enddo + elseif (imp_physics == Model%imp_physics_gfdl) then + clw(1:im,:,1) = Stateout%gq0(1:im,:,ntcw) + elseif (imp_physics == Model%imp_physics_thompson) 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 + if(Model%ltaerosol) then + ice00(:,:) = clw(:,:,1) + liq0(:,:) = clw(:,:,2) + else + ice00(:,:) = clw(:,:,1) + endif + elseif (imp_physics == Model%imp_physics_wsm6 .or. & + imp_physics == Model%imp_physics_mg) 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 + else + do i=1,im + psautco_l(i) = Model%psautco(1)*work1(i) + Model%psautco(2)*work2(i) + prautco_l(i) = Model%prautco(1)*work1(i) + Model%prautco(2)*work2(i) + 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 +! + if (Model%do_shoc .and. .not. Model%shocaftcnv) then + if (imp_physics == Model%imp_physics_mg) 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 + ncpl(i,k) = Stateout%gq0(i,k,ntlnc) + ncpi(i,k) = Stateout%gq0(i,k,ntinc) + enddo + enddo + if (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then + do k=1,levs + do i=1,im + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + enddo + enddo + elseif (Model%fprcp > 1) then + do k=1,levs + do i=1,im + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + Stateout%gq0(i,k,ntgl) +! clw(i,k,1) = clw(i,k,1) + Stateout%gq0(i,k,ntgl) + enddo + enddo + endif + elseif (imp_physics == Model%imp_physics_gfdl) then ! GFDL MP - needs modify for condensation + 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) + enddo + enddo + elseif (imp_physics == Model%imp_physics_zhao_carr .or. & + imp_physics == Model%imp_physics_zhao_carr_pdf) then + do k=1,levs + do i=1,im + if (abs(Stateout%gq0(i,k,ntcw)) < epsq) then + Stateout%gq0(i,k,ntcw) = zero + endif + tem = Stateout%gq0(i,k,ntcw) & + & * max(zero, MIN(one, (TCR-Stateout%gt0(i,k))*TCRF)) + clw(i,k,1) = tem ! ice + clw(i,k,2) = Stateout%gq0(i,k,ntcw) - tem ! water + enddo + enddo + endif + +! if (lprnt) write(0,*)'gt01=',Stateout%gt0(ipr,:) +! if (lprnt) write(0,*)'gq01=',Stateout%gq0(ipr,:,1) +! if (lprnt) write(0,*)'phii=',Statein%phii(ipr,:),' kdt=',kdt +! 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=',hflxq(ipr),' evap=',evapq(ipr),& +! ' stress=',stress(ipr) +! dtshoc = 60.0 +! dtshoc = 120.0 +! dtshoc = dtp +! dtshoc = min(dtp, 300.0) +! nshocm = max(1, nint(dtp/dtshoc)) +! dtshoc = dtp / nshocm +! do nshoc=1,nshocm +! if (lprnt) write(0,*)' before shoc tke=',clw(ipr,1:45,ntk), & +! &' kdt=',kdt,'xlon=',grid%xlon(ipr),' xlat=',grid%xlat(ipr) + +! phy_f3d(1,1,ntot3d-2) - shoc determined sgs clouds +! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients +! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' +! +! dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1) +! dqdt(1:im,:,2) = Stateout%gq0(1:im,:,ntiw) +! dqdt(1:im,:,3) = Stateout%gq0(1:im,:,ntcw) +!GFDL lat has no meaning inside of shoc - changed to "1" +!GFDL call shoc(ix, im, 1, levs, levs+1, dtp, me, lat, +! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtshoc, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Staotein%prsl(1,1), & +! write(0,*)' before shoc hflx=',hflxq, ' me=',me +! write(0,*)' before shoc evap=',evapq,' me=',me + call shoc (ix, im, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), del,& + Statein%phii(1,1), Statein%phil(1,1), Stateout%gu0(1,1), & + Stateout%gv0(1,1), Statein%vvl(1,1), Stateout%gt0(1,1), & + Stateout%gq0(1,1,1), clw(1,1,1), clw(1,1,2), qsnw, qrn, & + rhc, Model%sup, Model%shoc_parm(1), Model%shoc_parm(2), & + Model%shoc_parm(3), Model%shoc_parm(4), & + Model%shoc_parm(5), Tbd%phy_f3d(1,1,ntot3d-2), & + clw(1,1,ntk), hflxq, evapq, prnum, & + Tbd%phy_f3d(1,1,ntot3d-1), Tbd%phy_f3d(1,1,ntot3d), & + 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 +! do i=1,im +! clw(i,k,1) = clw(i,k,1) - Stateout%gq0(i,k,ntgl) +! enddo +! enddo +! endif + +! if (lprnt) write(0,*)'aftshocgt0=',Stateout%gt0(ipr,:) +! 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 +! if (lprnt) write(0,*)' aftshocice=',clw(ipr,:,1) +! if (lprnt) write(0,*)' aftshocwat=',clw(ipr,:,2) +! write(1000+me,*)' at latitude = ',lat +! rain1 = zero +! call moist_bud(im,im,ix,levs,me,kdt,con_g,dtp,del,rain1 +! &, dqdt(1,1,1), dqdt(1,1,2), dqdt(1,1,3) +! &, gq0(1,1,1),clw(1,1,2),clw(1,1,1),'shoc ') +! tem = 1000.0 +! call moist_bud(im,im,ix,levs,me,kdt,con_g,tem,del,rain1 & +! &, dqdt(1,1,1), dqdt(1,1,2), dqdt(1,1,3) & +! &, Stateout%gq0(1:ix,1:levs,1),clw(1,1,2),clw(1,1,1) & +! &, ' shoc ', grid%xlon(1:im), grid%xlat(1:im)) + + if (imp_physics == Model%imp_physics_mg) then + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntlnc) = ncpl(i,k) + Stateout%gq0(i,k,ntinc) = ncpi(i,k) + enddo + enddo + endif +! do k=1,levs +! do i=1,im +! sgs_cld(i,k) = sgs_cld(i,k) + shoc_cld(i,k) +! enddo +! enddo +! if (lprnt) write(0,*)' gt03=',gt0(ipr,1:10) +! if (lprnt) write(0,*)' tke=',clw(ipr,1:10,ntk) + +! if (lprnt) write(1000+me,*)' after shoc tke=',clw(1,:,ntk), +! &' kdt=',kdt +! enddo +! +! do k=1,levs +! write(1000+me,*)' maxcld=',maxval(sgs_cld(1:im,k)), +! write(1000+me,*)' maxtkh=',maxval(phy_f3d(1:im,k,ntot3d-1)), +! &' k=',k,' kdt=',kdt,' lat=',lat +! enddo + +! write(0,*)' aft shoc gt0=',gt0(1,:),' lat=',lat +! write(0,*)' aft shoc gq0=',gq0(1,:,1),' lat=',lat +! write(0,*)' aft shoc gu0=',gu0(1,:),' lat=',lat +! + endif ! if(do_shoc) + +! +! --- ... calling convective parameterization +! ----------------------------------- + if (Model%do_deep) then + + + if (.not. Model%ras .and. .not. Model%cscnv) then + + if (Model%imfdeepcnv == 1) then ! no random cloud top + call sascnvn (im, ix, levs, Model%jcap, dtp, del, & + Statein%prsl, Statein%pgr, Statein%phil, clw(:,:,1:2), & + Stateout%gq0(:,:,1), Stateout%gt0, Stateout%gu0, & + Stateout%gv0, cld1d, rain1, kbot, ktop, kcnv, & + islmsk, Statein%vvl, ncld, ud_mf, dd_mf, & + dt_mf, cnvw, cnvc, & + QLCN, QICN, w_upi,cf_upi, CNV_MFD, & +! QLCN, QICN, w_upi,cf_upi, CNV_MFD, CNV_PRC3, & + CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,imp_physics,& + Model%clam_deep, Model%c0s_deep, & + Model%c1_deep, Model%betal_deep, Model%betas_deep, & + Model%evfact_deep, Model%evfactl_deep, & + Model%pgcon_deep) + elseif (Model%imfdeepcnv == 2) then + if(.not. Model%satmedmf .and. .not. Model%trans_trac) then + nsamftrac = 0 + else + nsamftrac = tottracer + endif + call samfdeepcnv(im, ix, levs, dtp, itc, Model%ntchm, ntk, nsamftrac, & + del, Statein%prsl, Statein%pgr, Statein%phil, clw, & + Stateout%gq0(:,:,1), Stateout%gt0, & + Stateout%gu0, Stateout%gv0, Model%fscav, & + cld1d, rain1, kbot, ktop, kcnv, & + islmsk, garea, & + Statein%vvl, ncld, ud_mf, dd_mf, dt_mf, cnvw, cnvc, & + QLCN, QICN, w_upi,cf_upi, CNV_MFD, & +! QLCN, QICN, w_upi,cf_upi, CNV_MFD, CNV_PRC3, & + CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE, & + imp_physics, & + Model%clam_deep, Model%c0s_deep, & + Model%c1_deep, Model%betal_deep, Model%betas_deep, & + Model%evfact_deep, Model%evfactl_deep, & + Model%pgcon_deep, Model%asolfac_deep, & + Model%do_ca, Model%ca_closure, Model%ca_entr, & + Model%ca_trigger, Model%nthresh, Coupling%ca_deep, & + Coupling%condition) +! if (lprnt) print *,' rain1=',rain1(ipr) + !elseif (Model%imfdeepcnv == 3) then + ! if (Model%me==0) then + ! write(0,*) 'Error, GF convection scheme only available through CCPP' + ! stop + ! end if + !elseif (Model%imfdeepcnv == 4) then + ! if (Model%me==0) then + ! write(0,*) 'Error, New Tiedtke convection scheme only available through CCPP' + ! stop + ! end if + elseif (Model%imfdeepcnv == 0) then ! random cloud top + call sascnv (im, ix, levs, Model%jcap, dtp, del, & + Statein%prsl, Statein%pgr, Statein%phil, clw(:,:,1:2), & + Stateout%gq0(:,:,1), Stateout%gt0, Stateout%gu0, & + Stateout%gv0, cld1d, rain1, kbot, ktop, kcnv, & + islmsk, Statein%vvl, Tbd%rann, ncld, & + ud_mf, dd_mf, dt_mf, cnvw, cnvc, & + QLCN, QICN, w_upi,cf_upi, CNV_MFD, & +! QLCN, QICN, w_upi,cf_upi, CNV_MFD, CNV_PRC3, & + CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,imp_physics ) +! if (lprnt) print *,' rain1=',rain1(ipr),' rann=',rann(ipr,1) + endif + + if (Model%npdf3d == 3 .and. Model%num_p3d == 4) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = cnvw(i,k) + Tbd%phy_f3d(i,k,num3) = cnvc(i,k) + cnvw(i,k) = zero + cnvc(i,k) = zero + enddo + enddo + elseif (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = cnvw(i,k) + cnvw(i,k) = zero + enddo + enddo + endif +! + else ! ras or cscnv + fscav(:) = zero + if (Model%cscnv) then ! Chikira-Sugiyama convection scheme (via CSU) + + fswtr(:) = zero +! write(0,*)' bef cs_cconv phii=',phii(ipr,:) +! &,' sizefsc=',size(fscav) +! write(0,*)' bef cs_cconv otspt=',otspt,' kdt=',kdt,' me=',me +! do k=1,levs +! do i=1,im +! dqdt(i,k,1) = Stateout%gq0(i,k,1) +! dqdt(i,k,2) = clw(i,k,2) +! dqdt(i,k,3) = clw(i,k,1) +! enddo +! enddo + +! +! JLS NOTE: The convective mass fluxes (dt_mf, dd_mf and ud_mf) passed in and out of cs_conv have not been multiplied by +! the timestep (i.e, the are in kg/m2/sec) as they are in all other convective schemes. EMC is aware of this problem, +! and in the future will be fixing this discrepancy. In the meantime, CCPP will use the same mass flux standard_name +! and long_name as the other convective schemes, where the units are in kg/m2. (Aug 2018) +! +! if (lprnt) write(0,*)'befcsgt0=',Stateout%gt0(ipr,:) +! if (lprnt) write(0,*)'befcstke=',clw(ipr,1:25,ntk) + + allocate (sigmatot(im,levs), sigmafrac(im,levs)) + +! JLS NOTE: The variable rain1 output from cs_convr (called prec inside the subroutine) is a precipitation flux (kg/m2/sec), +! not meters LWE like the other schemes. It is converted to m after the call to cs_convr. + + call cs_convr (ix, im, levs, ntrac+1, nn, tottracer+3, & + Model%nctp, otspt(1:ntrac+1,1:2), 1, & + kdt, Stateout%gt0, Stateout%gq0(:,:,1:1), rain1, & + clw, Statein%phil, Statein%phii, Statein%prsl, & + Statein%prsi, dtp, dtf, ud_mf, dd_mf, dt_mf, & + Stateout%gu0, Stateout%gv0, fscav, fswtr, & + Tbd%phy_fctd, me, wcbmax, Model%cs_parm(3), & + Model%cs_parm(4), Model%cs_parm(9), sigmatot, & +! Model%cs_parm(4), sigmai, sigmatot, vverti, & + Model%do_aw, Model%do_awdd, Model%flx_form, & + lprnt, ipr, kcnv, QLCN, QICN, & + w_upi, cf_upi, CNV_MFD, CNV_DQLDT, & +! w_upi, cf_upi, CNV_MFD, CNV_PRC3, CNV_DQLDT, & + CLCN, CNV_FICE, CNV_NDROP, CNV_NICE, imp_physics) +! if (lprnt) write(0,*)'aftcsgt0=',Stateout%gt0(ipr,:) +! if (lprnt) write(0,*)'aftcstke=',clw(ipr,1:25,ntk) + +! write(1000+me,*)' at latitude = ',lat +! call moist_bud(im,im,ix,levs,me,kdt,con_g,dtp,del,rain1 +! &, dqdt(1,1,1), dqdt(1,1,2), dqdt(1,1,3) +! &, gq0(1,1,1),clw(1,1,2),clw(1,1,1),' cs_conv') +! tem = 1000.0 +! call moist_bud(im,im,ix,levs,me,kdt,con_g,tem,del,rain1 & +! &, dqdt(1,1,1), dqdt(1,1,2), dqdt(1,1,3) & +! &, Stateout%gq0(1:ix,1:levs,1),clw(1,1,2),clw(1,1,1) & +! &, ' cs_conv', grid%xlon(1:im), grid%xlat(1:im)) + + rain1(:) = rain1(:) * (dtp*con_p001) + if (Model%do_aw) then + do k=1,levs + kk = min(k+1,levs) ! assuming no cloud top reaches the model top + do i=1,im !DD + sigmafrac(i,k) = half * (sigmatot(i,k)+sigmatot(i,kk)) + enddo + enddo + endif +! if (lprnt) then +! write(0,*)' gt01=',stateout%gt0(ipr,:),' kdt=',kdt +! write(0,*)' gq01=',stateout%gq0(ipr,:,1),' kdt=',kdt +! write(0,*)' clw1=',clw(ipr,:,1),' kdt=',kdt +! write(0,*)' clw2=',clw(ipr,:,1),' kdt=',kdt +! write(0,*)' aft cs rain1=',rain1(ipr)*86400 +! write(0,*)' aft cs rain1=',rain1(ipr) +! endif + + else ! ras version 2 + + if (Model%ccwf(1) >= zero .or. Model%ccwf(2) >= 0) then + do i=1,im + ccwfac(i) = Model%ccwf(1)*work1(i) + Model%ccwf(2)*work2(i) + dlqfac(i) = Model%dlqf(1)*work1(i) + Model%dlqf(2)*work2(i) + psaur_l(i) = Model%psauras(1)*work1(i) + Model%psauras(2)*work2(i) + praur_l(i) = Model%prauras(1)*work1(i) + Model%prauras(2)*work2(i) + enddo + else + do i=1,im + ccwfac(i) = -999.0_kind_phys + dlqfac(i) = zero + psaur_l(i) = Model%psauras(1)*work1(i) + Model%psauras(2)*work2(i) + praur_l(i) = Model%prauras(1)*work1(i) + Model%prauras(2)*work2(i) + enddo + endif + +! if (lprnt) write(0,*) ' calling ras for kdt=',kdt,' me=',me & +! &, ' lprnt=',lprnt,' ccwfac=',ccwfac(ipr) + +! do k=1,levs +! do i=1,im +! dqdt(i,k,1) = Stateout%gq0(i,k,1) +! dqdt(i,k,2) = clw(i,k,2) +! dqdt(i,k,3) = clw(i,k,1) +! enddo +! enddo + + revap = .true. +! if (ncld ==2) revap = .false. + trcmin(:) = -999999.0_kind_phys + if (ntk-2 > 0) trcmin(ntk-2) = 1.0e-4_kind_phys +! if (lprnt) write(0,*)' gt04bras=',Stateout%gt0(ipr,:) +! if (lprnt) write(0,*)' gq04bras=',Stateout%gq0(ipr,:,1) +! if (lprnt) write(0,*)'befrasclw1=',clw(ipr,:,1) +! if (lprnt) write(0,*)'befrasclw2=',clw(ipr,:,2) +! if (lprnt) write(0,*)'befrastke=',clw(ipr,:,ntk) +! if (lprnt) write(0,*)'trcmin=',trcmin(ntk-2),' ntk=',ntk + call rascnv (im, ix, levs, dtp, dtf, Tbd%rann, Stateout%gt0, & + Stateout%gq0, Stateout%gu0, Stateout%gv0, clw, & + tottracer, fscav, Statein%prsi, Statein%prsl, & + Statein%prsik, Statein%prslk, Statein%phil, & + Statein%phii, kpbl, cd, rain1, kbot, ktop, kcnv, & + Tbd%phy_f2d(1,Model%num_p2d), Model%flipv, pa2mb, & + me, garea, ccwfac, Model%nrcm, rhc, ud_mf, & + dd_mf, dt_mf, praur_l, Model%wminras(1), & + psaur_l, Model%wminras(2), dlqfac, & + lprnt, ipr, kdt, revap, QLCN, & + QICN, w_upi, cf_upi, CNV_MFD, CNV_DQLDT, & +! QICN, w_upi, cf_upi, CNV_MFD, CNV_PRC3, CNV_DQLDT, & + CLCN, CNV_FICE, CNV_NDROP, CNV_NICE, imp_physics, & +! trcmin) + trcmin, ntk) + +! 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) + + endif + +! write(1000+me,*)' at latitude = ',lat +! tem = 1000.0 +! call moist_bud(im,im,ix,levs,me,kdt,con_g,tem,del,rain1 & +! &, dqdt(1,1,1), dqdt(1,1,2), dqdt(1,1,3) & +! &, Stateout%gq0(1:ix,1:levs,1),clw(1,1,2),clw(1,1,1) & +! &, ' ras_conv', grid%xlon(1:im), grid%xlat(1:im)) +! if(lprnt) write(0,*)' after ras rain1=',rain1(ipr),' me=',me,' kdt=',kdt +! &,' cnv_prc3sum=',sum(cnv_prc3(ipr,1:levs)) +! if (lprnt) write(0,*)' gt04=',gt0(ipr,1:10) + + cld1d = 0 + + endif ! end if_not_ras + + + else ! no parameterized deep convection + cld1d = zero + rain1 = zero + ud_mf = zero + dd_mf = zero + dt_mf = zero + endif + +! if (lprnt) then +! write(0,*)' aftcnvgt0=',stateout%gt0(ipr,:),' kdt=',kdt +! write(0,*)' aftcnvgq0=',(stateout%gq0(ipr,k,1),k=1,levs) +! write(0,*)' gq0i2=',(stateout%gq0(ipr,k,ntiw),k=1,levs) +! write(0,*)' aftcnvgq1=',(stateout%gq0(ipr,k,ntcw),k=1,levs) +! endif +! + do i=1,im + Diag%rainc(i) = frain * rain1(i) + enddo +! + if (Model%lssav) then + do i=1,im + Diag%cldwrk (i) = Diag%cldwrk (i) + cld1d(i) * dtf + enddo + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,4) = Diag%dt3dt(i,k,4) + (Stateout%gt0(i,k)-dtdt(i,k)) * frain +! Diag%dq3dt(i,k,2) = Diag%dq3dt(i,k,2) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + Diag%du3dt(i,k,3) = Diag%du3dt(i,k,3) + (Stateout%gu0(i,k)-dudt(i,k)) * frain + Diag%dv3dt(i,k,3) = Diag%dv3dt(i,k,3) + (Stateout%gv0(i,k)-dvdt(i,k)) * frain + +! Diag%upd_mf(i,k) = Diag%upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) +! Diag%dwn_mf(i,k) = Diag%dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) +! Diag%det_mf(i,k) = Diag%det_mf(i,k) + dt_mf(i,k) * (con_g*frain) + enddo + enddo + endif ! if (ldiag3d) + + endif ! end if_lssav +! + if (ldiag_ugwp) then + tem = frain/dtp + do k=1,levs + do i=1,im +! +! frain = dtf / dtp = 1 +! + PdUdt = (Stateout%gu0(i,k)-dudt(i,k)) * tem + PdVdt = (Stateout%gv0(i,k)-dVdt(i,k)) * tem + PdTdt = (Stateout%gt0(i,k)-dTdt(i,k)) * tem + + Diag%du3dt_moist(i,k) = Diag%du3dt_moist(i,k) + PdUdt + Diag%dv3dt_moist(i,k) = Diag%dv3dt_moist(i,k) + PdVdt + Diag%dt3dt_moist(i,k) = Diag%dt3dt_moist(i,k) + PdTdt +! +! Attention : frain and increments +! +! Tdudt(i,k) = Tdudt(i,k) + PdUdt * fdaily +! Tdvdt(i,k) = Tdvdt(i,k) + PdVdt * fdaily +! Tdtdt(i,k) = Tdtdt(i,k) + PdTdt * fdaily + enddo + enddo + endif +! if (Model%do_ugwp) then +! +! Put in the instantaneous "Diag%-arrays" to drive UGWP-convective triggers +! from previous time step we need: LH-release + cld_top/bot + precip +! +! endif + +! if (lprnt) write(7000,*)' bef cnvgwd gu0=',gu0(ipr,:) +! &,' lat=',lat,' kdt=',kdt,' me=',me +! if (lprnt) write(7000,*)' bef cnvgwd gv0=',gv0(ipr,:) +! +!----------------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 + +! --- ... calculate maximum convective heating rate + if (Model%do_cnvgwd) then ! call convective gravity wave drag + + allocate(gwdcu(im,levs), gwdcv(im,levs)) +! --- ... calculate maximum convective heating rate +! cuhr = temperature change due to deep convection + + do i=1,im + cumabs(i) = zero + work4 (i) = zero + enddo + do k=1,levs + do i=1,im + if (k >= kbot(i) .and. k <= ktop(i)) then + cumabs(i) = cumabs(i) + (Stateout%gt0(i,k)-dtdt(i,k)) * del(i,k) + work4(i) = work4(i) + del(i,k) + endif + enddo + enddo + do i=1,im + if (work4(i) > zero) cumabs(i) = cumabs(i) / (dtp*work4(i)) + enddo + +! DH* 20180817 - note: the above non-CCPP code modifies work3, which until then was defined +! as the ratio of the exner function between midlayer and interface at lowest model layer: +! work3(i) = Statein%prsik(i,1) / Statein%prslk(i,1) +! This does not happen for the CCPP code, because gwdc_pre uses an internal array +! work3 (maybe not a good name, given that we have work1/2/3 in GFS_physics_driver and +! in the GFS_Interstitial DDT). Therefore, work3 is different from here on until the end +! of GFS_physics_driver. This is ok as long as Model%lgocart is set to .false. - if +! Model%lgocart is set to .true., sfc_diag is called again, which uses work3 as input. +! This work3 used in sfc_diag should be the ratio of the exner function, not the modified +! value derived in the non-CCPP code above. If we get different results for the surface +! diagnstics with Model%lgocart=.true., then the CCPP code is correct! *DH 20180817 + +! do i = 1, im +! do k = kbot(i), ktop(i) +! do k1 = kbot(i), k +! cumchr(i,k) = cuhr(i,k1) + cumchr(i,k) +! enddo +! cumchr(i,k) = cumchr(i,k) / cumabs(i) +! enddo +! enddo + +! --- ... begin check print ****************************************** + +! if (lprnt) then +! if (kbot(ipr) <= ktop(ipr)) then +! write(*,*) 'kbot <= ktop for (lat,lon) = ', & +! & xlon(ipr)*rad2dg,xlat(ipr)*rad2dg +! write(*,*) 'kcnv kbot ktop dlength ',kcnv(ipr), & +! & kbot(ipr),ktop(ipr),dlength(ipr) +! write(*,9000) kdt +!9000 format(/,3x,'k',5x,'cuhr(k)',4x,'cumchr(k)',5x, & +! & 'at kdt = ',i4,/) + +! do k = ktop(ipr), kbot(ipr),-1 +! write(*,9010) k,(86400.*cuhr(ipr,k)),(100.*cumchr(ipr,k)) +!9010 format(2x,i2,2x,f8.2,5x,f6.0) +! enddo +! endif + +! if (fhour >= fhourpr) then +! print *,' before gwdc in gbphys start print' +! write(*,*) 'fhour ix im levs = ',fhour,ix,im,levs +! print *,'dtp dtf = ',dtp,dtf + +! write(*,9100) +!9100 format(//,14x,'pressure levels',// & +! & ' ilev',7x,'prsi',8x,'prsl',8x,'delp',/) + +! k = levs + 1 +! write(*,9110) k,(10.*prsi(ipr,k)) +!9110 format(i4,2x,f10.3) + +! do k = levs, 1, -1 +! write(*,9120) k,(10.*prsl(ipr,k)),(10.*del(ipr,k)) +! write(*,9110) k,(10.*prsi(ipr,k)) +! enddo +!9120 format(i4,12x,2(2x,f10.3)) + +! write(*,9130) +!9130 format(//,10x,'before gwdc in gbphys',//,' ilev',6x, & +! & 'ugrs',9x,'gu0',8x,'vgrs',9x,'gv0',8x, & +! & 'tgrs',9x,'gt0',8x,'gt0b',8x,'dudt',8x,'dvdt',/) + +! do k = levs, 1, -1 +! write(*,9140) k,ugrs(ipr,k),gu0(ipr,k), & +! & vgrs(ipr,k),gv0(ipr,k), & +! & tgrs(ipr,k),gt0(ipr,k),dtdt(ipr,k), & +! & dudt(ipr,k),dvdt(ipr,k) +! enddo +!9140 format(i4,9(2x,f10.3)) + +! print *,' before gwdc in gbphys end print' +! endif +! endif ! end if_lprnt + +! --- ... end check print ******************************************** + + +!GFDL replacing lat with "1" +! call gwdc(im, ix, im, levs, lat, gu0, gv0, gt0, gq0, dtp, & + call gwdc (im, ix, im, levs, 1, Statein%ugrs, Statein%vgrs, & + Statein%tgrs, Statein%qgrs(1,1,1), dtp, Statein%prsl, & + Statein%prsi, del, cumabs, ktop, kbot, kcnv, cldf, & + con_g, con_cp, con_rd, con_fvirt, con_pi, dlength, & + lprnt, ipr, Model%fhour, gwdcu, gwdcv, dusfcg, dvsfcg) + +! if (lprnt) then +! if (fhour >= fhourpr) then +! print *,' after gwdc in gbphys start print' + +! write(*,9131) +!9131 format(//,10x,'after gwdc in gbphys',//,' ilev',6x, & +! & 'ugrs',9x,'gu0',8x,'vgrs',9x,'gv0',8x, & +! & 'tgrs',9x,'gt0',8x,'gt0b',7x,'gwdcu',7x,'gwdcv',/) + +! do k = levs, 1, -1 +! write(*,9141) k,ugrs(ipr,k),gu0(ipr,k), & +! & vgrs(ipr,k),gv0(ipr,k), & +! & tgrs(ipr,k),gt0(ipr,k),dtdt(ipr,k), & +! & gwdcu(ipr,k),gwdcv(ipr,k) +! enddo +!9141 format(i4,9(2x,f10.3)) + +! print *,' after gwdc in gbphys end print' +! endif +! endif + +! --- ... write out cloud top stress and wind tendencies + if (Model%lssav) then + do i=1,im + Diag%dugwd(i) = Diag%dugwd(i) + dusfcg(i)*dtf + Diag%dvgwd(i) = Diag%dvgwd(i) + dvsfcg(i)*dtf + enddo + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%du3dt(i,k,4) = Diag%du3dt(i,k,4) + gwdcu(i,k) * dtf + Diag%dv3dt(i,k,4) = Diag%dv3dt(i,k,4) + gwdcv(i,k) * dtf + enddo + enddo + endif + endif ! end if_lssav + +! --- ... update the wind components with gwdc tendencies + + do k=1,levs + do i=1,im + eng0 = half*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + Stateout%gu0(i,k) = Stateout%gu0(i,k) + gwdcu(i,k) * dtp + Stateout%gv0(i,k) = Stateout%gv0(i,k) + gwdcv(i,k) * dtp + eng1 = half*(Stateout%gu0(i,k)*Stateout%gu0(i,k)+Stateout%gv0(i,k)*Stateout%gv0(i,k)) + Stateout%gt0(i,k) = Stateout%gt0(i,k) + (eng0-eng1)/(dtp*con_cp) + enddo +! if (lprnt) write(7000,*)' gu0=',gu0(ipr,k),' gwdcu=', +! &gwdcu(ipr,k), ' gv0=', gv0(ipr,k),' gwdcv=',gwdcv(ipr,k) +! &,' k=',k + enddo + +! if (lprnt) then +! if (fhour >= fhourpr) then +! print *,' after tendency gwdc in gbphys start print' + +! write(*,9132) +!9132 format(//,10x,'after tendency gwdc in gbphys',//,' ilev',6x,& +! & 'ugrs',9x,'gu0',8x,'vgrs',9x,'gv0',8x, & +! & 'tgrs',9x,'gt0',8x,'gt0b',7x,'gwdcu',7x,'gwdcv',/) + +! do k = levs, 1, -1 +! write(*,9142) k,ugrs(ipr,k),gu0(ipr,k),vgrs(ipr,k), & +! & gv0(ipr,k),tgrs(ipr,k),gt0(ipr,k),dtdt(ipr,k), & +! & gwdcu(ipr,k),gwdcv(ipr,k) +! enddo +!9142 format(i4,9(2x,f10.3)) + +! print *,' after tendency gwdc in gbphys end print' +! endif +! endif + + 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 +!----------------Convective gravity wave drag parameterization over -------- + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + dtdt(i,k) = Stateout%gt0(i,k) + enddo + enddo + endif + + if (.not. Model%do_shoc) then + + if (Model%shal_cnv) then ! Shallow convection parameterizations +! -------------------------------------- + if (Model%imfshalcnv == 1) then ! opr option now at 2014 + !----------------------- + call shalcnv (im, ix, levs, Model%jcap, dtp, del, Statein%prsl, & + Statein%pgr, Statein%phil, clw, Stateout%gq0, & + Stateout%gt0, Stateout%gu0, Stateout%gv0, rain1, & + kbot, ktop, kcnv, islmsk, Statein%vvl, ncld, & + Tbd%hpbl, hflxq, evapq, ud_mf, dt_mf, cnvw, cnvc, & + Model%clam_shal, Model%c0s_shal, Model%c1_shal, & + Model%pgcon_shal) + + do i=1,im + Diag%rainc(i) = Diag%rainc(i) + frain * rain1(i) + enddo +! in shalcnv, 'cnvw' and 'cnvc' are not set to zero + if (Model%shcnvcw .and. Model%num_p3d == 4 .and. Model%npdf3d == 3) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = Tbd%phy_f3d(i,k,num2) + cnvw(i,k) + Tbd%phy_f3d(i,k,num3) = Tbd%phy_f3d(i,k,num3) + cnvc(i,k) + enddo + enddo + elseif (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = Tbd%phy_f3d(i,k,num2) + cnvw(i,k) + enddo + enddo + endif + + elseif (Model%imfshalcnv == 2) then + if(.not. Model%satmedmf .and. .not. Model%trans_trac) then + nsamftrac = 0 + 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, & + Stateout%gu0, Stateout%gv0, Model%fscav, & + rain1, kbot, ktop, kcnv, islmsk, garea, & + Statein%vvl, ncld, Tbd%hpbl, ud_mf, & + dt_mf, cnvw, cnvc, & + Model%clam_shal, Model%c0s_shal, Model%c1_shal, & + Model%pgcon_shal, Model%asolfac_shal) + do i=1,im + Diag%rainc(i) = Diag%rainc(i) + frain * rain1(i) + enddo + +! in mfshalcnv, 'cnvw' and 'cnvc' are set to zero before computation starts: + if (Model%shcnvcw .and. Model%num_p3d == 4 .and. Model%npdf3d == 3) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = Tbd%phy_f3d(i,k,num2) + cnvw(i,k) + Tbd%phy_f3d(i,k,num3) = Tbd%phy_f3d(i,k,num3) + cnvc(i,k) + enddo + enddo + elseif (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) then + do k=1,levs + do i=1,im + Tbd%phy_f3d(i,k,num2) = Tbd%phy_f3d(i,k,num2) + cnvw(i,k) + enddo + enddo + endif + + !elseif (Model%imfshalcnv == 3) then + !if (Model%me==0) write(0,*) "CCPP DEBUG: shallow convection of GF is called in gf_driver" + + !elseif (Model%imfshalcnv == 4) then + !if (Model%me==0) write(0,*) "CCPP DEBUG: shallow convection of New Tiedtke is called in cu_tiedtke" + + elseif (Model%imfshalcnv == 0) then ! modified Tiedtke Shallow convecton + !----------------------------------- + levshc(:) = 0 + do k=2,levs + do i=1,im + dpshc = 0.3_kind_phys * Statein%prsi(i,1) + if (Statein%prsi(i,1)-Statein%prsi(i,k) <= dpshc) levshc(i) = k + enddo + enddo + levshcm = 1 + do i=1,im + levshcm = max(levshcm, levshc(i)) + enddo + +! if (lprnt) print *,' levshcm=',levshcm,' gt0sh=',gt0(ipr,:) +! &, ' lat=',lat + + if (Model%mstrat) then ! As in CFSv2 + call shalcv (im, ix, levshcm, dtp, del, Statein%prsi, & + Statein%prsl, Statein%prslk,kcnv, Stateout%gq0, & + Stateout%gt0, levshc, Statein%phil, kinver, & + ctei_r, ctei_rml, lprnt, ipr) + else + call shalcvt3 (im, ix, levshcm, dtp, del, Statein%prsi, & + Statein%prsl, Statein%prslk, kcnv, & + Stateout%gq0, Stateout%gt0) + endif +! if (lprnt) print *,' levshcm=',levshcm,' gt0sha=',gt0(ipr,:) + + endif ! end if_imfshalcnv + + endif ! end if_shal_cnv + + if (Model%lssav) then + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,5) = Diag%dt3dt(i,k,5) + (Stateout%gt0(i,k) -dtdt(i,k)) * frain +! Diag%dq3dt(i,k,3) = Diag%dq3dt(i,k,3) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + enddo + enddo + endif + endif ! end if_lssav + + if (Model%cplchm) then + do k=1,levs + do i=1,im + tem = (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + Coupling%dqdti(i,k) = Coupling%dqdti(i,k) + tem + enddo + enddo + endif +! + do k=1,levs + do i=1,im + if (clw(i,k,2) <= -999.0_kind_phys) clw(i,k,2) = zero + enddo + enddo +! if (lprnt) then +! write(0,*)' prsl=',prsl(ipr,:) +! write(0,*) ' del=',del(ipr,:) +! write(0,*) ' befshgt0=',gt0(ipr,:) +! write(0,*) ' befshgq0=',gq0(ipr,:,1) +! endif + + elseif (Model%shocaftcnv) then ! if do_shoc is true and shocaftcnv is true call shoc + if (imp_physics == Model%imp_physics_mg) then + do k=1,levs + do i=1,im + ncpl(i,k) = Stateout%gq0(i,k,ntlnc) + ncpi(i,k) = Stateout%gq0(i,k,ntinc) + enddo + enddo + +! else +! if (clw(1,1,2) < -999.0) then ! if clw is not partitioned to ice and water +! do k=1,levs +! do i=1,im +! tem = gq0(i,k,ntcw) & +! & * max(0.0, MIN(one, (TCR-gt0(i,k))*TCRF)) +! clw(i,k,1) = tem ! ice +! clw(i,k,2) = gq0(i,k,ntcw) - tem ! water +! enddo +! enddo +! endif ! Anning ncld ==2 + if (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then + do k=1,levs + do i=1,im + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + enddo + enddo + elseif (Model%fprcp > 1) then + do k=1,levs + do i=1,im + qrn(i,k) = Stateout%gq0(i,k,ntrw) + qsnw(i,k) = Stateout%gq0(i,k,ntsw) + Stateout%gq0(i,k,ntgl) + enddo + enddo + endif + endif + +! dtshoc = 60.0 +! dtshoc = min(dtp, 300.0) +! nshocm = max(1, nint(dtp/dtshoc)) +! dtshoc = dtp / nshocm +! do nshoc=1,nshocm +! call shoc(im, 1, levs, levs+1, dtp, me, lat, & +!! call shoc(im, 1, levs, levs+1, dtshoc, me, lat, & +! & prsl(1:im,:), phii (1:im,:), phil(1:im,:),& +! & gu0(1:im,:),gv0(1:im,:), vvl(1:im,:), gt0(1:im,:), & +! & gq0(1:im,:,1), & +! & clw(1:im,:,1), clw(1:im,:,2), qsnw, qrn, sgs_cld(1:im,:)& +! &, gq0(1:im,:,ntke), & +! & phy_f3d(1:im,:,ntot3d-1), phy_f3d(1:im,:,ntot3d), & +! & lprnt, ipr, & +! & con_cp, con_g, con_hvap, con_hfus, con_hvap+con_hfus, & +! & con_rv, con_rd, con_pi, con_fvirt) + +!GFDL replace lat with "1: +! call shoc(ix, im, 1, levs, levs+1, dtshoc, me, lat, & +! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & + call shoc (ix, im, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), del, & + Statein%phii(1,1), Statein%phil(1,1), Stateout%gu0(1,1), & + Stateout%gv0(1,1), Statein%vvl(1,1), Stateout%gt0(1,1), & + Stateout%gq0(1,1,1), clw(1,1,1), clw(1,1,2), qsnw, qrn, & + rhc, Model%sup, Model%shoc_parm(1), Model%shoc_parm(2), & + Model%shoc_parm(3), Model%shoc_parm(4), & + Model%shoc_parm(5), Tbd%phy_f3d(1,1,ntot3d-2), & + clw(1,1,ntk), hflxq, evapq, prnum, & + Tbd%phy_f3d(1,1,ntot3d-1), Tbd%phy_f3d(1,1,ntot3d), & + lprnt, ipr, imp_physics, ncpl, ncpi) +! enddo + + if (imp_physics == Model%imp_physics_mg) then + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntlnc) = ncpl(i,k) + Stateout%gq0(i,k,ntinc) = ncpi(i,k) + enddo + enddo + endif + +! +! do k=1,levs +! write(1000+me,*)' maxtkh=',maxval(phy_f3d(1:im,k,ntot3d-1)), & +! ' k=',k,' kdt=',kdt,' lat=',lat +! enddo + +! write(0,*)' aft shoc gt0=',gt0(1,:),' lat=',lat +! write(0,*)' aft shoc gq0=',gq0(1,:,1),' lat=',lat +! write(0,*)' aft shoc gu0=',gu0(1,:),' lat=',lat +! + endif ! if( .not. do_shoc) +! +! if (lprnt) then +! write(0,*)' prsl=',prsl(ipr,:) +! write(0,*) ' del=',del(ipr,:) +! write(0,*) ' aftshgt0=',gt0(ipr,:) +! write(0,*) ' aftshgq0=',gq0(ipr,:,1) +! endif +! +!------------------------------------------------------------------------------ +! --- update the tracers due to deep & shallow cumulus convective transport +! (except for suspended water and ice) +! + if (tottracer > 0) then + tracers = 2 + do n=2,ntrac +! 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 + do i=1,im + Stateout%gq0(i,k,n) = clw(i,k,tracers) + enddo + enddo + endif + enddo + endif +!------------------------------------------------------------------------------- +! + if (ntcw > 0) then + +! for microphysics + + if (imp_physics == Model%imp_physics_zhao_carr .or. & + imp_physics == Model%imp_physics_zhao_carr_pdf .or. & + imp_physics == Model%imp_physics_gfdl) then + Stateout%gq0(1:im,:,ntcw) = clw(1:im,:,1) + clw(1:im,:,2) + elseif (ntiw > 0) then + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntiw) = clw(i,k,1) ! ice + Stateout%gq0(i,k,ntcw) = clw(i,k,2) ! water + enddo + enddo + if (imp_physics == Model%imp_physics_thompson) then + if (Model%ltaerosol) then + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntlnc) = Stateout%gq0(i,k,ntlnc) & + + max(zero, (clw(i,k,2)-liq0(i,k))) / liqm + Stateout%gq0(i,k,ntinc) = Stateout%gq0(i,k,ntinc) & + + max(zero, (clw(i,k,1)-ice00(i,k))) / icem + enddo + enddo + else + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntinc) = Stateout%gq0(i,k,ntinc) & + + max(zero, (clw(i,k,1)-ice00(i,k))) / icem + enddo + enddo + endif + endif + else + do k=1,levs + do i=1,im + Stateout%gq0(i,k,ntcw) = clw(i,k,1) + clw(i,k,2) + enddo + enddo + endif ! end if_ntiw + else + do k=1,levs + do i=1,im + clw(i,k,1) = clw(i,k,1) + clw(i,k,2) + enddo + 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, & + Tbd%acv, Tbd%acvb, Tbd%acvt, Cldprop%cv, Cldprop%cvb, Cldprop%cvt) + + if (Model%moist_adj) then ! moist convective adjustment +! --------------------------- +! +! To call moist convective adjustment +! +! if (lprnt) then +! print *,' prsl=',prsl(ipr,:) +! print *,' del=',del(ipr,:) +! print *,' gt0b=',gt0(ipr,:) +! print *,' gq0b=',gq0(ipr,:,1) +! endif + + call mstcnv (im, ix, levs, dtp, Stateout%gt0, Stateout%gq0, & + Statein%prsl,del, Statein%prslk, rain1, & + Stateout%gq0(1,1,ntcw), rhc, lprnt, ipr) + +! if (lprnt) then +! print *,' rain1=',rain1(ipr),' rainc=',rainc(ipr) +! print *,' gt0a=',gt0(ipr,:) +! print *,' gq0a=',gq0(ipr,:,1) +! endif + do i=1,im + Diag%rainc(i) = Diag%rainc(i) + frain * rain1(i) + enddo + +! if(Model%lssav) then +! update dqdt_v to include moisture tendency due to surface processes +! dqdt_v : instaneous moisture tendency (kg/kg/sec) +! if (Model%ldiag3d) then +! do k=1,levs +! do i=1,im +! Diag%dt3dt(i,k,8) = Diag%dt3dt(i,k,8) + (Stateout%gt0(i,k) -dtdt(i,k) ) * frain +!! Diag%dq3dt(i,k,2) = Diag%dq3dt(i,k,2) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain +! enddo +! enddo +! endif +! endif + endif ! moist convective adjustment over + if (Model%ldiag3d .or. Model%do_aw) then + do k=1,levs + do i=1,im + dtdt(i,k) = Stateout%gt0(i,k) + dqdt(i,k,1) = Stateout%gq0(i,k,1) + enddo + enddo + do n=ntcw,ntcw+nncl-1 + dqdt(1:im,:,n) = Stateout%gq0(1:im,:,n) + enddo + endif +! dqdt_v : instaneous moisture tendency (kg/kg/sec) +! Note: ( these lines are relevant for shallow and deep convection) + if (Model%cplchm) then + do k=1,levs + do i=1,im + Coupling%dqdti(i,k) = Coupling%dqdti(i,k) * (one / dtf) + enddo + enddo + endif +! +! grid-scale condensation/precipitations and microphysics parameterization +! ------------------------------------------------------------------------ + + if (ncld == 0) then ! no cloud microphysics + + call lrgscl (ix, im, levs, dtp, Stateout%gt0, Stateout%gq0, & + Statein%prsl, del, Statein%prslk, rain1, clw) + else ! all microphysics + + if (imp_physics == Model%imp_physics_zhao_carr) then ! call zhao/carr/sundqvist microphysics + ! ------------ + + allocate(rainp(im,levs)) +! if (lprnt) then +! write(0,*)' prsl=',prsl(ipr,:) +! write(0,*) ' del=',del(ipr,:) +! write(0,*) ' beflsgt0=',gt0(ipr,:),' kdt=',kdt +! write(0,*) ' beflsgq0=',gq0(ipr,:,1),' kdt=',kdt +! write(0,*) ' beflsgw0=',gq0(ipr,:,3),' kdt=',kdt +! endif + ! ------------------ + if (Model%do_shoc) then + call precpd_shoc (im, ix, levs, dtp, del, Statein%prsl, & + Stateout%gq0(1,1,1), Stateout%gq0(1,1,ntcw), & + Stateout%gt0, rain1, Diag%sr, rainp, rhc, & + psautco_l, prautco_l, Model%evpco, Model%wminco, & + Tbd%phy_f3d(1,1,ntot3d-2), lprnt, ipr) + else + call gscond (im, ix, levs, dtp, dtf, Statein%prsl, Statein%pgr, & + Stateout%gq0(1,1,1), Stateout%gq0(1,1,ntcw), & + Stateout%gt0, Tbd%phy_f3d(1,1,1), Tbd%phy_f3d(1,1,2), & + Tbd%phy_f2d(1,1), Tbd%phy_f3d(1,1,3), & + Tbd%phy_f3d(1,1,4), Tbd%phy_f2d(1,2), rhc,lprnt, ipr) + call precpd (im, ix, levs, dtp, del, Statein%prsl, & + Stateout%gq0(1,1,1), Stateout%gq0(1,1,ntcw), & + Stateout%gt0, rain1, Diag%sr, rainp, rhc, psautco_l, & + prautco_l, Model%evpco, Model%wminco, lprnt, ipr) + endif +! if (lprnt) then +! write(0,*)' prsl=',prsl(ipr,:) +! write(0,*) ' del=',del(ipr,:) +! write(0,*) ' aftlsgt0=',gt0(ipr,:),' kdt=',kdt +! write(0,*) ' aftlsgq0=',gq0(ipr,:,1),' kdt=',kdt +! write(0,*) ' aftlsgw0=',gq0(ipr,:,3),' kdt=',kdt +! write(0,*)' aft precpd rain1=',rain1(1:3),' lat=',lat +! endif + + deallocate(rainp) + elseif (imp_physics == Model%imp_physics_zhao_carr_pdf) then ! with pdf clouds + allocate(rainp(im,levs)) + call gscondp (im, ix, levs, dtp, dtf, Statein%prsl, & + Statein%pgr, Stateout%gq0(1,1,1), & + Stateout%gq0(1,1,ntcw), Stateout%gt0, & + Tbd%phy_f3d(1,1,1), Tbd%phy_f3d(1,1,2), & + Tbd%phy_f2d(1,1), Tbd%phy_f3d(1,1,3), & + Tbd%phy_f3d(1,1,4), Tbd%phy_f2d(1,2), rhc, & + Tbd%phy_f3d(1,1,Model%num_p3d+1), Model%sup, & + lprnt, ipr, kdt) + + call precpdp (im, ix, levs, dtp, del, Statein%prsl, & + Statein%pgr, Stateout%gq0(1,1,1), & + Stateout%gq0(1,1,ntcw), Stateout%gt0, & + rain1, Diag%sr, rainp, rhc, & + Tbd%phy_f3d(1,1,Model%num_p3d+1), psautco_l, & + prautco_l, Model%evpco, Model%wminco, lprnt, ipr) + deallocate(rainp) + +! if (lprnt) write(0,*) ' rain1=',rain1(ipr),' rainc=',rainc(ipr),' lat=',lat + + elseif (imp_physics == Model%imp_physics_thompson) then ! Thompson MP + ! ------------ + ims = 1 ; ime = ix ; kms = 1 ; kme = levs ; its = 1 ; ite = ix ; kts = 1 ; kte = levs + + if (Model%ltaerosol) then + print*,'aerosol version of the Thompson scheme is not included' + +! call mp_gt_driver(ims,ime,kms,kme,its,ite,kts,kte, & +! Stateout%gq0(1:im,1:levs,1), & +! Stateout%gq0(1:im,1:levs,Model%ntcw), Stateout%gq0(1:im,1:levs,Model%ntrw), & +! Stateout%gq0(1:im,1:levs,Model%ntiw), Stateout%gq0(1:im,1:levs,Model%ntsw), & +! Stateout%gq0(1:im,1:levs,Model%ntgl), Stateout%gq0(1:im,1:levs,Model%ntinc),& +! Stateout%gq0(1:im,1:im,Model%ntrnc), & +! Stateout%gt0, Statein%prsl, Statein%vvl, del, dtp, kdt, & +! rain1, & +! Diag%sr, & +!! Diag%refl_10cm, Model%lradar, & +!! Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3), & !has_reqc, has_reqi, has_reqs, +!! ims,ime,kms,kme,its,ite,kts,kte) +! Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3),me, & +! nc=Stateout%gq0(1:im,1:levs,Model%ntlnc), & +! nwfa=Stateout%gq0(1:im,1:levs,Model%ntwa), & +! nifa=Stateout%gq0(1:im,1:levs,Model%ntia), & +!! nwfa2d=Sfcprop%nwfa2d(1:im)) +! nwfa2d=Coupling%nwfa2d(1:im)) + else + call mp_gt_driver(ims,ime,kms,kme,its,ite,kts,kte, & + Stateout%gq0(1:im,1:levs,1), & + Stateout%gq0(1:im,1:levs,Model%ntcw), Stateout%gq0(1:im,1:levs,Model%ntrw), & + Stateout%gq0(1:im,1:levs,Model%ntiw), Stateout%gq0(1:im,1:levs,Model%ntsw), & + Stateout%gq0(1:im,1:levs,Model%ntgl), Stateout%gq0(1:im,1:levs,Model%ntinc),& + Stateout%gq0(1:im,1:levs,Model%ntrnc), & +!2014v Stateout%gt0, Statein%prsl, Statein%vvl, del, dtp, kdt, & + Stateout%gt0, Statein%prsl, del, dtp, kdt, & + rain1, & + Diag%sr, & + islmsk, & + Diag%refl_10cm, Model%lradar, & + Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3),me,Statein%phii) + endif + elseif (imp_physics == Model%imp_physics_wsm6) then ! WSM6 + ims = 1 ; ime = ix ; kms = 1 ; kme = levs ; its = 1 ; ite = ix ; kts = 1 ; kte = levs + + call wsm6(Stateout%gt0, Statein%phii(1:im,1:levs+1), & + Stateout%gq0(1:im,1:levs,1), & + Stateout%gq0(1:im,1:levs,Model%ntcw), & + Stateout%gq0(1:im,1:levs,Model%ntrw), & + Stateout%gq0(1:im,1:levs,Model%ntiw), & + Stateout%gq0(1:im,1:levs,Model%ntsw), & + Stateout%gq0(1:im,1:levs,Model%ntgl), & + Statein%prsl, del, dtp, rain1, & + Diag%sr, & + islmsk, & + Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3), & + ims,ime, kms,kme, & + its,ite, kts,kte) +! + elseif (imp_physics == Model%imp_physics_mg) then ! MGB double-moment microphysics + ! ------------------------------ + 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 + 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 + 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 + enddo + enddo + + endif + + 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 + 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) + 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) + enddo + enddo + 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)) + enddo + enddo + +! notice clw ix instead of im +! call m_micro_driver(im,ix,levs,flipv,del,dtp,prsl,prsi, +! & prslk,prsik,pgr,vvl,clw(1,1,2), QLCN, clw(1,1,1),QICN, +! if (lprnt) write(0,*)' cnv_mfdbef=',cnv_mfd(ipr,:),' flipv=',flipv +! 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 +! if (lprnt) write(0,*)' qsnwb=',qsnw(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' qglb=',qgl(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' rhc=',rhc(ipr,:),' kdt=',kdt,' kk=',kk +! if (lprnt) write(0,*)' cloudsb=',Tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt +! if (lprnt) write(0,*)' cloudsb=',Tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt +! if (lprnt) write(0,*)' clcn=',clcn(ipr,:)*100,' kdt=',kdt +! txa(:,:) = Stateout%gq0(:,:,1) +! do k=1,levs +! 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, Tbd%Hpbl, CNV_MFD, CNV_DQLDT, & +! FRLAND, Tbd%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, & + 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 +! write(1000+me,*)' at kdt = ',kdt +! tem = 1000.0 + +! call moist_bud2(im,ix,ix,levs,me,kdt,con_g,tem,del,rain1 & +! &, txa, clw(1,1,2), clw(1,1,1) & +! &, Stateout%gq0(1:ix,1:levs,ntrw),Stateout%gq0(1:ix,1:levs,ntsw)& +! &, Stateout%gq0(1:ix,1:levs,ntgl) & +! &, Stateout%gq0(1:ix,1:levs,1),Stateout%gq0(1:ix,1:levs,ntcw) & +! &, Stateout%gq0(1:ix,1:levs,ntiw) & +! &, qrn, qsnw, qgl, ' m_micro ', grid%xlon(1:im), grid%xlat(1:im)) + +! if (lprnt) write(0,*) ' rain1=',rain1(ipr)*86400.0, & +! &' rainc=',diag%rainc(ipr)*86400.0 +! &,' 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,*)' 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 +! if (lprnt) write(0,*)' clw2aft=',stateout%gq0(ipr,:,ntcw),' kdt=',kdt +! if (lprnt) write(0,*)' qrna=',qrn(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt + + + 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 + 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 + 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 + +! if (lprnt) write(0,*)' cloudsm=',Tbd%phy_f3d(ipr,:,1)*100,' kdt=',kdt +! if (lprnt) write(0,*)' clw2aft=',stateout%gq0(ipr,:,ntcw),' kdt=',kdt +! if (lprnt) write(0,*)' qrna=',qrn(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' qsnwa=',qsnw(ipr,:),' kdt=',kdt +! if (lprnt) write(0,*)' qglba',qgl(ipr,:),' kdt=',kdt +! + + elseif (imp_physics == Model%imp_physics_gfdl) then ! GFDL MP + ! ------- + do i = 1, im + land (i,1) = frland(i) + area (i,1) = Grid%area(i) + rain0 (i,1) = zero + snow0 (i,1) = zero + ice0 (i,1) = zero + graupel0 (i,1) = zero + enddo + + do k = 1, levs + kk = levs-k+1 + do i = 1, im + qn1 (i,1,k) = zero + qv_dt(i,1,k) = zero + ql_dt(i,1,k) = zero + qr_dt(i,1,k) = zero + qi_dt(i,1,k) = zero + qs_dt(i,1,k) = zero + qg_dt(i,1,k) = zero + qa_dt(i,1,k) = zero + pt_dt(i,1,k) = zero + udt (i,1,k) = zero + vdt (i,1,k) = zero +! + qv1 (i,1,k) = Stateout%gq0(i,kk,1) + ql1 (i,1,k) = Stateout%gq0(i,kk,ntcw) + qr1 (i,1,k) = Stateout%gq0(i,kk,ntrw) + qi1 (i,1,k) = Stateout%gq0(i,kk,ntiw) + qs1 (i,1,k) = Stateout%gq0(i,kk,ntsw) + qg1 (i,1,k) = Stateout%gq0(i,kk,ntgl) + qa1 (i,1,k) = Stateout%gq0(i,kk,ntclamt) + pt (i,1,k) = Stateout%gt0(i,kk) + w (i,1,k) = -Statein%vvl(i,kk)*(one+con_fvirt*qv1(i,1,k)) & + * Stateout%gt0(i,kk) / Statein%prsl(i,kk) * (con_rd*onebg) + uin (i,1,k) = Stateout%gu0(i,kk) + vin (i,1,k) = Stateout%gv0(i,kk) + delp (i,1,k) = del(i,kk) + dz (i,1,k) = (Statein%phii(i,kk)-Statein%phii(i,kk+1)) * onebg + p123 (i,1,k) = Statein%prsl(i,kk) + refl (i,1,k) = Diag%refl_10cm(i,kk) + enddo + enddo + + + call gfdl_cloud_microphys_driver(qv1, ql1, qr1, qi1, qs1, qg1, qa1, & + qn1, qv_dt, ql_dt, qr_dt, qi_dt, & + qs_dt, qg_dt, qa_dt, pt_dt, pt, w, & + uin, vin, udt, vdt, dz, delp, & + area, dtp, land, rain0, snow0, & + ice0, graupel0, .false., .true., & + 1, im, 1, 1, 1, levs, 1, levs, & + seconds,p123,Model%lradar,refl, & + reset) + tem = dtp * con_p001 / con_day + do i = 1, im +! rain0(i,1) = max(zero, rain0(i,1)) +! snow0(i,1) = max(zero, snow0(i,1)) +! ice0(i,1) = max(zero, ice0(i,1)) +! graupel0(i,1) = max(zero, graupel0(i,1)) + if (rain0(i,1)*tem < rainmin) then + rain0(i,1) = zero + endif + if (ice0(i,1)*tem < rainmin) then + ice0(i,1) = zero + endif + if (snow0(i,1)*tem < rainmin) then + snow0(i,1) = zero + endif + if (graupel0(i,1)*tem < rainmin) then + graupel0(i,1) = zero + endif + + rain1(i) = (rain0(i,1)+snow0(i,1)+ice0(i,1)+graupel0(i,1)) * tem + Diag%ice(i) = ice0 (i,1) * tem + Diag%snow(i) = snow0 (i,1) * tem + Diag%graupel(i) = graupel0(i,1) * tem + if ( rain1(i) > rainmin ) then + Diag%sr(i) = (snow0(i,1) + ice0(i,1) + graupel0(i,1)) & + / (rain0(i,1) + snow0(i,1) + ice0(i,1) + graupel0(i,1)) + else + Diag%sr(i) = zero + endif + enddo +#ifdef REPRO + ! Convert rain0, ice0, graupel0 and snow0 from mm/day to m/physics-timestep + ! for later use (approx. lines 7970, calculation of srflag) + rain0 = tem*rain0 + ice0 = tem*ice0 + snow0 = tem*snow0 + graupel0 = tem*graupel0 +#endif + do k = 1, levs + kk = levs-k+1 + do i=1,im + Stateout%gq0(i,k,1 ) = qv1(i,1,kk) + qv_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntcw) = ql1(i,1,kk) + ql_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntrw) = qr1(i,1,kk) + qr_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntiw) = qi1(i,1,kk) + qi_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntsw) = qs1(i,1,kk) + qs_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntgl) = qg1(i,1,kk) + qg_dt(i,1,kk) * dtp + Stateout%gq0(i,k,ntclamt) = qa1(i,1,kk) + qa_dt(i,1,kk) * dtp + Stateout%gt0(i,k) = Stateout%gt0(i,k) + pt_dt(i,1,kk) * dtp + Stateout%gu0(i,k) = Stateout%gu0(i,k) + udt (i,1,kk) * dtp + Stateout%gv0(i,k) = Stateout%gv0(i,k) + vdt (i,1,kk) * dtp + Diag%refl_10cm(i,k) = refl(i,1,kk) + enddo + + + if (Model%effr_in) then + do i =1, im + den(i,k) = 0.622_kind_phys*Statein%prsl(i,k) / & + (con_rd*Stateout%gt0(i,k)*(Stateout%gq0(i,k,1)+0.622_kind_phys)) + enddo + 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 + do i=1,im + Diag%refdmax(I) = -35.0_kind_phys + Diag%refdmax263k(I) = -35.0_kind_phys + enddo + 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), & + del(1:im,1:levs), islmsk(1:im), & + Stateout%gq0(1:im,1:levs,ntcw), Stateout%gq0(1:im,1:levs,ntiw), & + Stateout%gq0(1:im,1:levs,ntrw), & + Stateout%gq0(1:im,1:levs,ntsw)+Stateout%gq0(1:im,1:levs,ntgl), & + Stateout%gq0(1:im,1:levs,ntgl)*0.0, Stateout%gt0(1:im,1:levs), & + Tbd%phy_f3d(1:im,1:levs,1), Tbd%phy_f3d(1:im,1:levs,2), & + Tbd%phy_f3d(1:im,1:levs,3), Tbd%phy_f3d(1:im,1:levs,4), & + Tbd%phy_f3d(1:im,1:levs,5)) + +! do k = 1, levs +! do i=1,im +! if(Model%me==0) then +! if(Tbd%phy_f3d(i,k,1) > 5.) then +! write(6,*) 'phy driver:cloud radii:',Model%kdt, i,k, & +! Tbd%phy_f3d(i,k,1) +! endif +! if(Tbd%phy_f3d(i,k,3)> zero) then +! write(6,*) 'phy driver:rain radii:',Model%kdt, i,k, & +! Tbd%phy_f3d(i,k,3) +! endif +! +! endif +! enddo +! enddo + + endif + + endif ! end of if(Model%imp_physics) + endif ! end if_ncld + +! if (lprnt) write(0,*)' rain1 after ls=',rain1(ipr) +! + if (Model%cscnv .and. Model%do_aw) then +! Arakawa-Wu adjustment of large-scale microphysics tendencies: +! reduce by factor of (1-sigma) +! these are microphysics increments. We want to keep (1-sigma) of the increment, +! we will remove sigma*increment from final values +! fsigma = zero ! don't apply any AW correction, in addition comment next line +! fsigma = sigmafrac + +! adjust sfc rainrate for conservation +! vertically integrate reduction of water increments, reduce precip by that amount + + temrain1(:) = zero + do k = 1,levs + do i = 1,im + tem1 = sigmafrac(i,k) + Stateout%gt0(i,k) = Stateout%gt0(i,k) - tem1 * (Stateout%gt0(i,k)-dtdt(i,k)) + tem2 = tem1 * (Stateout%gq0(i,k,1)-dqdt(i,k,1)) + Stateout%gq0(i,k,1) = Stateout%gq0(i,k,1) - tem2 + temrain1(i) = temrain1(i) - (Statein%prsi(i,k)-Statein%prsi(i,k+1)) & + * tem2 * onebg + enddo + enddo +! add convective clouds if shoc is true and not MG microphysics + if (Model%do_shoc .and. imp_physics /= Model%imp_physics_mg) then + do k = 1,levs + do i = 1,im + Tbd%phy_f3d(i,k,ntot3d-2) = min(one, Tbd%phy_f3d(i,k,ntot3d-2) & + & + sigmafrac(i,k)) + enddo + enddo + endif + +! if (lprnt) write(0,*)' gt0aftpraw=',Stateout%gt0(ipr,:),' kdt=',kdt,'me=',me + do n=ntcw,ntcw+nncl-1 + do k = 1,levs + do i = 1,im + tem1 = sigmafrac(i,k) * (Stateout%gq0(i,k,n)-dqdt(i,k,n)) + Stateout%gq0(i,k,n) = Stateout%gq0(i,k,n) - tem1 + temrain1(i) = temrain1(i) - (Statein%prsi(i,k)-Statein%prsi(i,k+1)) & + * tem1 * onebg + enddo + enddo + enddo +! write(1000+me,*)' rain1=',rain1(4),' temrain1=',temrain1(i)*0.001 + do i = 1,im + rain1(i) = max(rain1(i) - temrain1(i)*con_p001, zero) + enddo + endif + + Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) ! total rain per timestep + +! --- get the amount of different precip type for Noah MP +! --- convert from m/dtp to mm/s + if (Model%lsm==Model%lsm_noahmp) then + if (Model%imp_physics == Model%imp_physics_mg .or. & + Model%imp_physics == Model%imp_physics_gfdl) then + !GJF: Should all precipitation rates have the same denominator below? + ! It appears that Diag%rain and Diag%rainc are on the dynamics time step, + ! but Diag%snow,graupel,ice are on the physics time step? This doesn't + ! matter as long as dtp=dtf (frain=1). + tem = one / (dtp*con_p001) + Sfcprop%draincprv(:) = tem * Diag%rainc(:) + Sfcprop%drainncprv(:) = tem * (frain * rain1(:)) + Sfcprop%dsnowprv(:) = tem * Diag%snow(:) + Sfcprop%dgraupelprv(:) = tem * Diag%graupel(:) + Sfcprop%diceprv(:) = tem * Diag%ice(:) + else + Sfcprop%draincprv(:) = zero + Sfcprop%drainncprv(:) = zero + Sfcprop%dsnowprv(:) = zero + Sfcprop%dgraupelprv(:) = zero + Sfcprop%diceprv(:) = zero + endif + end if ! if (Model%lsm == Model%lsm_noahmp) + + if (Model%cal_pre) then ! hchuang: add dominant precipitation type algorithm +! + call calpreciptype (kdt, Model%nrcm, im, ix, levs, levs+1, & + Tbd%rann, Grid%xlat, Grid%xlon, Stateout%gt0, & + Stateout%gq0, Statein%prsl, Statein%prsi, & + Diag%rain, Statein%phii, Sfcprop%tsfc, & !input + domr, domzr, domip, doms) ! output +! +! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' +! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) +! do i=1,im +! if (abs(xlon(i)*rad2dg-114.0) .lt. 0.2 .and. +! & abs(xlat(i)*rad2dg- 40.0) .lt. 0.2) +! & print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ', +! & DOMR(i),DOMZR(i),DOMIP(i),DOMS(i) +! enddo +! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation + + if (Model%imp_physics /= Model%imp_physics_gfdl) then + do i=1,im + Sfcprop%tprcp(i) = max(zero, Diag%rain(i) ) + if(doms(i) > zero .or. domip(i) > zero) then + Sfcprop%srflag(i) = one + else + Sfcprop%srflag(i) = zero + endif + enddo + endif + if (Model%lssav) then + do i=1,im + Diag%tdomr(i) = Diag%tdomr(i) + domr(i) * dtf + Diag%tdomzr(i) = Diag%tdomzr(i) + domzr(i) * dtf + Diag%tdomip(i) = Diag%tdomip(i) + domip(i) * dtf + Diag%tdoms(i) = Diag%tdoms(i) + doms(i) * dtf + enddo + endif + + endif + +!-------------------------------- +! vay-2018 for Dycore-Tendencies save Stateout%X => Diag%dX3dt_cgw +! + if (ldiag_ugwp) then + Diag%dt3dt_cgw = Stateout%gt0 + Diag%dv3dt_cgw = Stateout%gv0 + Diag%du3dt_cgw = Stateout%gu0 + endif +!-------------------------------- + +! --- ... estimate t850 for rain-snow decision + + t850(1:im) = Stateout%gt0(1:im,1) + + do k = 1, levs-1 + do i = 1, im + if (Statein%prsl(i,k) > p850 .and. Statein%prsl(i,k+1) <= p850) then + t850(i) = Stateout%gt0(i,k) - (Statein%prsl(i,k)-p850) / & + (Statein%prsl(i,k)-Statein%prsl(i,k+1)) * & + (Stateout%gt0(i,k)-Stateout%gt0(i,k+1)) + endif + enddo + enddo + + if (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL microphysics + ! ----------------- +! determine convective rain/snow by surface temperature +! determine large-scale rain/snow by rain/snow coming out directly from MP + tem = dtp * con_p001 / con_day + do i = 1, im + Sfcprop%tprcp(i) = max(zero, Diag%rain(i) )! clu: rain -> tprcp + Sfcprop%srflag(i) = zero ! clu: default srflag as 'rain' (i.e. 0) + if (Sfcprop%tsfc(i) >= 273.15_kind_phys) then + crain = Diag%rainc(i) + csnow = zero + else + crain = zero + csnow = Diag%rainc(i) + endif +! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then +! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > zero) then +! Sfcprop%srflag(i) = one ! clu: set srflag to 'snow' (i.e. 1) +! endif +! compute fractional srflag +#ifdef REPRO + ! For bit-for-bit identical results with CCPP code, snow0/ice0/graupel0/rain0 + ! were converted from mm per day to m per physics timestep previously in the code + total_precip = snow0(i,1)+ice0(i,1)+graupel0(i,1)+rain0(i,1)+Diag%rainc(i) + if (total_precip > rainmin) then + Sfcprop%srflag(i) = (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow)/total_precip + endif +#else + tem1 = snow0(i,1)+ice0(i,1)+graupel0(i,1) + total_precip = (tem1+rain0(i,1)) * tem + Diag%rainc(i) + if (total_precip > rainmin) then + Sfcprop%srflag(i) = (tem1*tem+csnow) / total_precip + endif +#endif + enddo + elseif( .not. Model%cal_pre) then + if (Model%imp_physics == Model%imp_physics_mg) then ! MG microphysics + ! --------------- + do i=1,im + if (Diag%rain(i) > rainmin) then + tem1 = max(zero, (Diag%rain(i)-Diag%rainc(i))) * Diag%sr(i) + tem2 = one / Diag%rain(i) + if (t850(i) > 273.16_kind_phys) then + Sfcprop%srflag(i) = max(zero, min(one, tem1*tem2)) + else + Sfcprop%srflag(i) = max(zero, min(one, (tem1+Diag%rainc(i))*tem2)) + endif + else + Sfcprop%srflag(i) = zero + Diag%rain(i) = zero + Diag%rainc(i) = zero + endif + Sfcprop%tprcp(i) = max(zero, Diag%rain(i)) + enddo + else ! not GFDL or MG microphysics + ! --------------------------- + do i = 1, im + Sfcprop%tprcp(i) = max(zero, Diag%rain(i)) + Sfcprop%srflag(i) = Diag%sr(i) + enddo + endif + endif + + if (Model%lssav) then +! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & +! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & +! 'rain=',Diag%rain(1) + do i=1,im + Diag%cnvprcp(i) = Diag%cnvprcp(i) + Diag%rainc(i) + Diag%totprcp (i) = Diag%totprcp (i) + Diag%rain(i) + Diag%totice (i) = Diag%totice (i) + Diag%ice(i) + Diag%totsnw (i) = Diag%totsnw (i) + Diag%snow(i) + Diag%totgrp (i) = Diag%totgrp (i) + Diag%graupel(i) +! + Diag%cnvprcpb(i) = Diag%cnvprcpb(i) + Diag%rainc(i) + Diag%totprcpb(i) = Diag%totprcpb(i) + Diag%rain(i) + Diag%toticeb (i) = Diag%toticeb (i) + Diag%ice(i) + Diag%totsnwb (i) = Diag%totsnwb (i) + Diag%snow(i) + Diag%totgrpb (i) = Diag%totgrpb (i) + Diag%graupel(i) + enddo + + if (Model%ldiag3d) then + do k=1,levs + do i=1,im + Diag%dt3dt(i,k,6) = Diag%dt3dt(i,k,6) + (Stateout%gt0(i,k)-dtdt(i,k)) * frain +! Diag%dq3dt(i,k,4) = Diag%dq3dt(i,k,4) + (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + enddo + enddo + endif + endif + +! --- ... coupling insertion + + if (Model%cplflx .or. Model%cplchm) then + do i = 1, im + Tbd%dsnow_cpl(i)= max(zero, Diag%rain(i) * Sfcprop%srflag(i)) + Tbd%drain_cpl(i)= max(zero, Diag%rain(i) - Tbd%dsnow_cpl(i)) + Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Tbd%drain_cpl(i) + Coupling%snow_cpl(i) = Coupling%snow_cpl(i) + Tbd%dsnow_cpl(i) + enddo + endif + + if (Model%cplchm) then + do i = 1, im + Coupling%rainc_cpl(i) = Coupling%rainc_cpl(i) + Diag%rainc(i) + enddo + endif +! --- ... end coupling insertion + +! --- ... total runoff is composed of drainage into water table and +! runoff at the surface and is accumulated in unit of meters + if (Model%lssav) then + do i=1,im + Diag%runoff(i) = Diag%runoff(i) + (drain(i)+runof(i)) * dtf + Diag%srunoff(i) = Diag%srunoff(i) + runof(i) * dtf + enddo + endif +! --- ... return updated smsoil and stsoil to global arrays + if (Model%frac_grid) then + do k=1,lsoil + do i=1,im + if (dry(i)) then + Sfcprop%smc(i,k) = smsoil(i,k) + Sfcprop%stc(i,k) = stsoil(i,k) + Sfcprop%slc(i,k) = slsoil(i,k) + endif + enddo + enddo + else + do k=1,lsoil + do i=1,im + Sfcprop%smc(i,k) = smsoil(i,k) + Sfcprop%stc(i,k) = stsoil(i,k) + Sfcprop%slc(i,k) = slsoil(i,k) + enddo + enddo + endif + +! --- ... calculate column precipitable water "pwat" + Diag%pwat(:) = zero + do k = 1, levs + do i=1,im + work1(i) = zero + enddo + if (ncld > 0) then + do ic = ntcw, ntcw+nncl-1 + do i=1,im + work1(i) = work1(i) + Stateout%gq0(i,k,ic) + enddo + enddo + endif + do i=1,im + Diag%pwat(i) = Diag%pwat(i) + del(i,k)*(Stateout%gq0(i,k,1)+work1(i)) + enddo +! if (lprnt .and. i == ipr) write(0,*)' gq0=', +! &gq0(i,k,1),' qgrs=',qgrs(i,k,1),' work2=',work2(i),' k=',k + enddo + do i=1,im + Diag%pwat(i) = Diag%pwat(i) * onebg + enddo + +! tem = dtf * 0.03456 / 86400.0 +! write(1000+me,*)' pwat=',pwat(i),'i=',i,', +! &' rain=',rain(i)*1000.0,' dqsfc1=',dqsfc1(i)*hefac(i)*tem,' kdt=',kdt +! &,' e-p=',dqsfc1(i)*hefac(i)*tem-rain(i)*1000.0 +! if (lprnt) write(0,*)' pwat=',pwat(ipr),', +! &' rain=',rain(ipr)*1000.0,' dqsfc1=',dqsfc1(ipr)*hefac(ipr)*tem,' kdt=',kdt +! &,' e-p=',dqsfc1(ipr)*hefac(ipr)*tem-rain(ipr)*1000.0 + +! +! if (lprnt .and. rain(ipr) > 5) call mpi_quit(5678) +! if (lat == 45) write(1000+me,*)' pwat=',pwat(1),' kdt=',kdt +! if (lprnt) then +! write(7000,*) ' endgu0=',gu0(ipr,:),' kdt=',kdt +! write(7000,*) ' endgv0=',gv0(ipr,:),' kdt=',kdt,' nnp=',nnp +! write(0,*) ' endgt0=',Stateout%gt0(ipr,:),' kdt=',kdt +! write(0,*) ' endgq0=',Stateout%gq0(ipr,:,1),' kdt=',kdt +! write(0,*) ' endgw0=',gq0(ipr,:,3),' kdt=',kdt,' lat=',lat +! write(0,*) ' endzorl=',Sfcprop%zorl(ipr),' kdt=',kdt +! endif + + if (Model%do_sppt .or. Model%ca_global)then +!--- radiation heating rate + Tbd%dtdtr(1:im,:) = Tbd%dtdtr(1:im,:) + dtdtc(1:im,:)*dtf + endif + deallocate (clw) + if (allocated(cnvc)) deallocate(cnvc) + if (allocated(cnvw)) deallocate(cnvw) + if (allocated(qrn)) deallocate(qrn) + if (allocated(qsnw)) deallocate(qsnw) + if (allocated(qgl)) deallocate(qgl) + if (allocated(ncpl)) deallocate(ncpl) + if (allocated(ncpi)) deallocate(ncpi) + if (allocated(ncpr)) deallocate(ncpr) + if (allocated(ncps)) deallocate(ncps) + if (allocated(ncgl)) deallocate(ncgl) + + if (allocated(liq0)) deallocate(liq0) + if (allocated(ice00)) deallocate(ice00) + + +! deallocate (fscav, fswtr) +! +! if (lprnt) write(0,*)' end of gbphys maxu=', +! &maxval(gu0(1:im,1:levs)),' minu=',minval(gu0(1:im,1:levs)) +! &,' maxv=',maxval(gv0(1:im,1:levs)),' minv=', +! & minval(gv0(1:im,1:levs)),' kdt=',kdt,' lat=',lat,' nnp=',nnp +! if (lprnt) write(0,*)' end of gbphys gv0=',gv0(:,120:128) +! if (lprnt) write(0,*)' end of gbphys at kdt=',kdt,& +! &' rain=',rain(ipr),' rainc=',rainc(ipr) +! if (lprnt) call mpi_quit(7) +! if (kdt > 2 ) call mpi_quit(70) +! 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 + +! deallocate (qlcn, qicn, w_upi, cf_upi, CNV_MFD, CNV_PRC3, & + deallocate (qlcn, qicn, w_upi, cf_upi, CNV_MFD, & + CNV_DQLDT, clcn, cnv_fice, cnv_ndrop, cnv_nice) + if (imp_physics == Model%imp_physics_gfdl) then + deallocate (delp, dz, uin, vin, pt, qv1, ql1, qr1, & + qg1, qa1, qn1, qi1, qs1, pt_dt, qa_dt, udt, vdt, & + w, qv_dt, ql_dt, qr_dt, qi_dt, qs_dt, qg_dt,p123,refl) + deallocate (den) + endif + if (allocated(tke)) deallocate (tke) + if (Model%cscnv) then + deallocate (sigmatot, sigmafrac) + endif +! + if (reset) then + do i=1, im +! find max hourly wind speed then decompose + Diag%spd10max(i) = -999.0_kind_phys + Diag%u10max(i) = -999.0_kind_phys + Diag%v10max(i) = -999.0_kind_phys + Diag%t02max(i) = -999.0_kind_phys + Diag%t02min(i) = 999.0_kind_phys + Diag%rh02max(i) = -999.0_kind_phys + Diag%rh02min(i) = 999.0_kind_phys + enddo + endif + do i=1, im +! find max hourly wind speed then decompose + tem = sqrt(Diag%u10m(i)*Diag%u10m(i) + Diag%v10m(i)*Diag%v10m(i)) + if (tem > Diag%spd10max(i)) then + Diag%spd10max(i) = tem + Diag%u10max(i) = Diag%u10m(i) + Diag%v10max(i) = Diag%v10m(i) + endif + pshltr = Statein%pgr(i)*exp(-0.068283_kind_phys/Stateout%gt0(i,1)) + QCQ = PQ0/pshltr*EXP(A2A*(Sfcprop%t2m(i)-A3)/(Sfcprop%t2m(i)-A4)) + rh02 = Sfcprop%q2m(i) / QCQ + IF (rh02 > one) THEN + rh02 = one + ENDIF + IF (rh02 < RHmin) THEN !use smaller RH limit for stratosphere + rh02 = RHmin + ENDIF + Diag%rh02max(i) = max(Diag%rh02max(i), rh02) + Diag%rh02min(i) = min(Diag%rh02min(i), rh02) + Diag%T02MAX(I) = MAX(Diag%T02MAX(I), Sfcprop%t2m(i)) !<--- Hourly max 2m T + Diag%T02MIN(I) = MIN(Diag%T02MIN(I), Sfcprop%t2m(i)) !<--- Hourly min 2m T + enddo +! if (kdt > 2 ) stop + +! if (Model%nstf_name(1) > 0) then +! if (lprnt) write(0,*)' end driver sfcprop%tref=',Sfcprop%tref(ipr),' kdt=',kdt +! endif +! if (Model%frac_grid) then +! if (lprnt) write(0,*)' end driver sfcprop%tsfcl=',Sfcprop%tsfcl(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tsfco=',Sfcprop%tsfco(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt +! if (lprnt) write(0,*)' end driver sfcprop%tsfc=',Sfcprop%tsfc(ipr),' kdt=',kdt,wet(ipr),icy(ipr),dry(ipr) +! endif + + return +!................................... + end subroutine GFS_physics_driver +!----------------------------------- + + + subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) + use machine, only : kind_phys + integer, intent(in) :: im,levs + real (kind=kind_phys), intent(in) :: grav + real (kind=kind_phys), intent(in),dimension(im,levs) :: phil,ref3D,tk + integer :: i,k,ll,ipt,kpt + real :: dbz1avg,zmidp1,zmidloc,refl,fact + real, dimension(im,levs) :: z + real, dimension(im) :: zintsfc + real, dimension(im), intent(inout) :: refd,refd263k + REAL :: dbz1(2),dbzk,dbzk1 + logical counter + do i=1,im + do k=1,levs + z(i,k) = phil(i,k)/grav + enddo + enddo + do i=1,im + refd(I) = -35. + vloop: do k=1,levs-1 + if ( z(i,k+1) >= 1000. .and. z(i,k) <= 1000.) then + zmidp1 = z(i,k+1) + zmidLOC = z(i,k) + dbz1(1) = ref3d(i,k+1) !- dBZ (not Z) values + dbz1(2) = ref3d(i,k) !- dBZ values + exit vloop + endif + enddo vloop + +!!! Initial curefl value without reduction above freezing level +! +! curefl=0. +! if (cprate(i,j)>0.) then +! cuprate=rdtphs*cprate(i,j) +! curefl=cu_a*cuprate**cu_b +! endif + do ll=1,2 + refl=0. + if (dbz1(ll)>-35.) refl=10.**(0.1*dbz1(ll)) +! dbz1(l)=curefl+refl !- in Z units + dbz1(ll)=refl + enddo +!-- Vertical interpolation of Z (units of mm**6/m**3) + fact=(1000.-zmidloc)/(zmidloc-zmidp1) + dbz1avg=dbz1(2)+(dbz1(2)-dbz1(1))*fact +!-- Convert to dBZ (10*logZ) as the last step + if (dbz1avg>0.01) then + dbz1avg=10.*alog10(dbz1avg) + else + dbz1avg=-35. + endif + refd(I)=max(refd(I),dbz1avg) + enddo + +!-- refl at -10C + do i=1,im + dbz1(1) = -35. + dbz1(2) = -35. + vloopm10: do k=1,levs-1 + if (tk(i,k+1) .le. 263.15 .and. tk(i,k) .ge. 263.15) then + dbz1(1)=ref3d(i,k+1) !- dBZ (not Z) values + dbz1(2)=ref3d(i,k) !- dBZ values + exit vloopm10 + endif + enddo vloopm10 + + do ll=1,2 + refl=0. + if (dbz1(ll)>-35.) refl=10.**(0.1*dbz1(ll)) +! dbz1(l)=curefl+refl !- in Z units + dbz1(ll)=refl + enddo +!-- Take max of bounding reflectivity values + dbz1avg=maxval(dbz1) +!-- Convert to dBZ (10*logZ) as the last step + if (dbz1avg>0.01) then + dbz1avg=10.*alog10(dbz1avg) + else + dbz1avg=-35. + endif + refd263K(I)=dbz1avg + enddo + end subroutine max_fields + + subroutine moist_bud(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & + qv0,ql0,qi0,qv1,ql1,qi1,comp, xlon, xlat) +! nov 2016 - S. Moorthi - routine to compute local moisture budget + use machine, only : kind_phys + implicit none + character*10 :: comp + integer :: im,ix,ix2,levs,me,kdt + real (kind=kind_phys) :: grav, rain(im), dtp, xlon(im), xlat(im) + real (kind=kind_phys), dimension(ix,levs) :: qv0,ql0,qi0,delp + real (kind=kind_phys), dimension(ix2,levs) :: qv1,ql1,qi1 + REAL (kind=kind_phys), dimension(im) :: sumq, sumqv, sumql, sumqi + integer :: i, k +! + do i=1,im + sumqv(i) = 0.0_kind_phys + sumql(i) = 0.0_kind_phys + sumqi(i) = 0.0_kind_phys + sumq (i) = 0.0_kind_phys + enddo + do k=1,levs + do i=1,im + sumqv(i) = sumqv(i) + (qv1(i,k) - qv0(i,k)) * delp(i,k) + sumql(i) = sumql(i) + (ql1(i,k) - ql0(i,k)) * delp(i,k) + sumqi(i) = sumqi(i) + (qi1(i,k) - qi0(i,k)) * delp(i,k) + enddo + enddo + do i=1,im + sumqv(i) = - sumqv(i) * (1.0_kind_phys/grav) + sumql(i) = - sumql(i) * (1.0_kind_phys/grav) + sumqi(i) = - sumqi(i) * (1.0_kind_phys/grav) + sumq (i) = sumqv(i) + sumql(i) + sumqi(i) + enddo + do i=1,im + write(2000+me,*)' in moist_bud:',' i=',i,' sumq=',sumq(i), & + ' sumqv=',sumqv(i),' sumql=',sumql(i),' sumqi=',sumqi(i), & + ' rain=',rain(i)*dtp,' kdt=',kdt,' component=',trim(comp), & + ' qv:=',qv1(i,1),qv0(i,1),' ql=',ql1(i,1),ql0(i,1), & + ' qi=',qi1(i,1), qi0(i,1),' xlon=',xlon(i),' xlat=',xlat(i) + enddo + return + + end subroutine moist_bud + + + subroutine moist_bud2(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & + qv0,ql0,qi0,qr0,qs0,qg0, & + qv1,ql1,qi1,qr1,qs1,qg1,comp,xlon,xlat) +! aug 2018 - S. Moorthi - routine to compute local moisture budget + use machine, only : kind_phys + implicit none + character*10 :: comp + integer :: im,ix,ix2,levs,me,kdt + real (kind=kind_phys) :: grav, rain(im), dtp, oneog, xlon(im), xlat(im) + real (kind=kind_phys), dimension(ix,levs) :: qv0,ql0,qi0,delp, & + qr0,qs0,qg0 + real (kind=kind_phys), dimension(ix2,levs) :: qv1,ql1,qi1, & + qr1,qs1,qg1 + REAL (kind=kind_phys), dimension(im) :: sumq, sumqv, sumql, sumqi, & + sumqr, sumqs, sumqg + integer :: i, k +! + do i=1,im + sumqv(i) = 0.0_kind_phys + sumql(i) = 0.0_kind_phys + sumqi(i) = 0.0_kind_phys + sumqr(i) = 0.0_kind_phys + sumqs(i) = 0.0_kind_phys + sumqg(i) = 0.0_kind_phys + sumq (i) = 0.0_kind_phys + enddo + do k=1,levs + do i=1,im + sumqv(i) = sumqv(i) + (qv1(i,k) - qv0(i,k)) * delp(i,k) + sumql(i) = sumql(i) + (ql1(i,k) - ql0(i,k)) * delp(i,k) + sumqi(i) = sumqi(i) + (qi1(i,k) - qi0(i,k)) * delp(i,k) + sumqr(i) = sumqr(i) + (qr1(i,k) - qr0(i,k)) * delp(i,k) + sumqs(i) = sumqs(i) + (qs1(i,k) - qs0(i,k)) * delp(i,k) + sumqg(i) = sumqg(i) + (qg1(i,k) - qg0(i,k)) * delp(i,k) + enddo + enddo + oneog = 1.0_kind_phys / grav + do i=1,im + sumqv(i) = - sumqv(i) * oneog + sumql(i) = - sumql(i) * oneog + sumqi(i) = - sumqi(i) * oneog + sumqr(i) = - sumqr(i) * oneog + sumqs(i) = - sumqs(i) * oneog + sumqg(i) = - sumqg(i) * oneog + sumq (i) = sumqv(i) + sumql(i) + sumqi(i) + sumqr(i) & + + sumqs(i) + sumqg(i) + enddo + do i=1,im + write(1000+me,*)' in moist_bud:',' i=',i,' sumq=',sumq(i), & + ' sumqv=',sumqv(i),' sumql=',sumql(i),' sumqi=',sumqi(i), & + ' sumqr=',sumqr(i),' sumqs=',sumqs(i),' sumqg=',sumqg(i), & + ' rain=',rain(i)*dtp,' kdt=',kdt,' component=',trim(comp), & + ' qv:=',qv1(i,1),qv0(i,1),' ql=',ql1(i,1),ql0(i,1), & + ' qi=',qi1(i,1), qi0(i,1),' qr=',qr1(i,1),qr0(i,1), & + ' qs=',qs1(i,1), qs0(i,1),' qg=',qg1(i,1),qg0(i,1), & + ' xlon=',xlon(i),' xlat=',xlat(i) + enddo + return + + end subroutine moist_bud2 + + +!> @} + +end module module_physics_driver + From fd60abf0e138df2a1f8f5523a6c3e387ae99f6ab Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 28 Oct 2020 20:29:43 -0400 Subject: [PATCH 095/217] updating mg3 and using wfrac in ipd --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 18 ++++---- .../GFS_layer/GFS_physics_driver.F90_clean | 19 ++++---- gfsphysics/physics/micro_mg3_0.F90 | 43 ++++++++++++------- 3 files changed, 46 insertions(+), 34 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index f0e9f3ed1..06d731365 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -496,7 +496,7 @@ subroutine GFS_physics_driver & real(kind=kind_phys) :: & dtf, dtp, frain, tem, tem1, tem2, & xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, & - txl, txi, txo, dt_warm, & + txl, txi, txo, wfrac, dt_warm, & !--- experimental for shoc sub-stepping dtshoc, & !--- GFDL Cloud microphysics @@ -2087,9 +2087,10 @@ subroutine GFS_physics_driver & do i=1, im ! ! Three-way composites (fields from sfc_diff) - txl = frland(i) - txi = fice(i)*(one - frland(i)) ! txi = ice fraction wrt whole cell - txo = max(zero, one - txl - txi) + txl = frland(i) ! land fraction + wfrac = one - txl ! water fraction (ocean/lake) + txi = fice(i) * wfrac ! txi = ice fraction wrt whole cell + txo = max(zero, wfrac - txi) ! txo = open water fraction ! if (i == ipr .and. lprnt) write(0,*)' txl=',txl,' fice=',fice(i),' txi=',txi,& ! ' txo=',txo,' dry=',dry(i),' wet=',wet(i),' icy=',icy(i),' oceanfrac=',& @@ -2118,11 +2119,10 @@ subroutine GFS_physics_driver & ! Sfcprop%tprcp(i) = txl*tprcp3(i,1) + txi*tprcp3(i,2) + txo*tprcp3(i,3) if (.not. flag_cice(i) .and. islmsk(i) == 2) then - tem = one - txl - evap(i) = txl*evap3(i,1) + tem*evap3(i,2) - hflx(i) = txl*hflx3(i,1) + tem*hflx3(i,2) - qss(i) = txl*qss3(i,1) + tem*qss3(i,2) - gflx(i) = txl*gflx3(i,1) + tem*gflx3(i,2) + evap(i) = txl*evap3(i,1) + wfrac*evap3(i,2) + hflx(i) = txl*hflx3(i,1) + wfrac*hflx3(i,2) + qss(i) = txl*qss3(i,1) + wfrac*qss3(i,2) + gflx(i) = txl*gflx3(i,1) + wfrac*gflx3(i,2) else evap(i) = txl*evap3(i,1) + txi*evap3(i,2) + txo*evap3(i,3) hflx(i) = txl*hflx3(i,1) + txi*hflx3(i,2) + txo*hflx3(i,3) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean index 66c1e282b..a3df20f78 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -489,7 +489,7 @@ module module_physics_driver real(kind=kind_phys) :: & dtf, dtp, frain, tem, tem1, tem2, & xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, & - txl, txi, txo, dt_warm, & + txl, txi, txo, wfrac, dt_warm, & !--- experimental for shoc sub-stepping dtshoc, & !--- GFDL Cloud microphysics @@ -1899,7 +1899,6 @@ module module_physics_driver ! do i=1,im ! if (icy(i) .and. islmsk(i) < 2) then ! if (Sfcprop%oceanfrac(i) > zero) then -! tem = Model%min_seaice ! if (fice(i) >= Model%min_seaice) then ! islmsk(i) = 4 ! tice(i) = min(Sfcprop%tisfc(i), tgice) @@ -1972,9 +1971,10 @@ module module_physics_driver do i=1, im ! ! Three-way composites (fields from sfc_diff) - txl = frland(i) - txi = fice(i)*(one - frland(i)) ! txi = ice fraction wrt whole cell - txo = max(zero, one - txl - txi) + txl = frland(i) ! land fraction + wfrac = one -txl ! water fraction (ocean/lake) + txi = fice(i)*wfrac ! txi = ice fraction wrt whole cell + txo = max(zero, wfrac - txi) ! txo = open water fraction ! if (i == ipr .and. lprnt) write(0,*)' txl=',txl,' fice=',fice(i),' txi=',txi,& ! ' txo=',txo,' dry=',dry(i),' wet=',wet(i),' icy=',icy(i),' oceanfrac=',& @@ -2003,11 +2003,10 @@ module module_physics_driver ! Sfcprop%tprcp(i) = txl*tprcp3(i,1) + txi*tprcp3(i,2) + txo*tprcp3(i,3) if (.not. flag_cice(i) .and. islmsk(i) == 2) then - tem = one - txl - evap(i) = txl*evap3(i,1) + tem*evap3(i,2) - hflx(i) = txl*hflx3(i,1) + tem*hflx3(i,2) - qss(i) = txl*qss3(i,1) + tem*qss3(i,2) - gflx(i) = txl*gflx3(i,1) + tem*gflx3(i,2) + evap(i) = txl*evap3(i,1) + wfrac*evap3(i,2) + hflx(i) = txl*hflx3(i,1) + wfrac*hflx3(i,2) + qss(i) = txl*qss3(i,1) + wfrac*qss3(i,2) + gflx(i) = txl*gflx3(i,1) + wfrac*gflx3(i,2) else evap(i) = txl*evap3(i,1) + txi*evap3(i,2) + txo*evap3(i,3) hflx(i) = txl*hflx3(i,1) + txi*hflx3(i,2) + txo*hflx3(i,3) diff --git a/gfsphysics/physics/micro_mg3_0.F90 b/gfsphysics/physics/micro_mg3_0.F90 index b170ccd70..773f183c0 100644 --- a/gfsphysics/physics/micro_mg3_0.F90 +++ b/gfsphysics/physics/micro_mg3_0.F90 @@ -1063,7 +1063,7 @@ subroutine micro_mg_tend ( & integer i, k, n ! number of sub-steps for loops over "n" (for sedimentation) - integer nstep, mdust, nlb, nstep_def + integer nstep, mdust, nlb, nstep_def, kmin, kminp1 ! Varaibles to scale fall velocity between small and regular ice regimes. ! real(r8) :: irad, ifrac, tsfac @@ -1075,6 +1075,11 @@ subroutine micro_mg_tend ( & ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & real(r8), parameter :: qimax=0.010_r8, qimin=0.005_r8, qiinv=one/(qimax-qimin) ! ts_au_min=180.0 + real(r8), parameter :: pmin_sed = 5000.0 ! layer pressure in Pa below which + ! sedimentation calcuation is + ! done +! integer, parameter :: nstep_fac=10 ! factor for definng nstep_def + integer, parameter :: nstep_fac=5 ! factor for definng nstep_def !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -1084,8 +1089,7 @@ subroutine micro_mg_tend ( & ! assign variable deltat to deltatin deltat = deltatin oneodt = one / deltat -! nstep_def = max(1, nint(deltat/20)) - nstep_def = max(1, nint(deltat/5)) + nstep_def = max(1, nint(deltat/nstep_fac)) ! tsfac = log(ts_au/ts_au_min) * qiinv ! Copies of input concentrations that may be changed internally. @@ -2176,7 +2180,7 @@ subroutine micro_mg_tend ( & ! 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) +! ' mu=',mu(1,k),' sc=',sc(1,k),' asn=',asn(1,k),' lams=',lams(1,k),' n0s=',n0s(1,k),' ni=',ni(1,k) bergs(:,k) = bergs(:,k) * micro_mg_berg_eff_factor @@ -3394,11 +3398,19 @@ subroutine micro_mg_tend ( & tx1 = tx2 * deltat tx3 = tx2 / g + kmin = 1 + do k=2,nlev-1 + if (p(i,k) < pmin_sed) then + kmin = k + endif + enddo + kminp1 = kmin + 1 + do n = 1,nstep ! top of model - k = 1 + k = kmin ! add fallout terms to microphysical tendencies @@ -3419,7 +3431,7 @@ subroutine micro_mg_tend ( & iflx(i,k+1) = iflx(i,k+1) + falouti(k) * tx3 ! Ice flux - do k = 2,nlev + do k = kminp1,nlev ! for cloud liquid and ice, if cloud fraction increases with height ! then add flux from above to both vapor and cloud water of current level @@ -3488,7 +3500,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = 1 + k = kmin tx5 = dumc(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -3507,7 +3519,7 @@ subroutine micro_mg_tend ( & faloutnc(k) = fnc(i,k) * dumnc(i,k) lflx(i,k+1) = lflx(i,k+1) + faloutc(k) * tx3 - do k = 2,nlev + do k = kminp1,nlev if (lcldm(i,k-1) > mincld) then dum1 = max(zero, min(one, lcldm(i,k)/lcldm(i,k-1))) @@ -3571,7 +3583,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = 1 + k = kmin ! add fallout terms to microphysical tendencies @@ -3592,7 +3604,7 @@ subroutine micro_mg_tend ( & rflx(i,k+1) = rflx(i,k+1) + faloutr(k) * tx3 - do k = 2,nlev + do k = kminp1,nlev tx5 = dumr(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -3633,7 +3645,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = 1 + k = kmin ! add fallout terms to microphysical tendencies @@ -3654,7 +3666,7 @@ subroutine micro_mg_tend ( & sflx(i,k+1) = sflx(i,k+1) + falouts(k) * tx3 - do k = 2,nlev + do k = kminp1,nlev tx5 = dums(i,k) @@ -3700,7 +3712,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = 1 + k = kmin ! add fallout terms to microphysical tendencies @@ -3721,7 +3733,7 @@ subroutine micro_mg_tend ( & gflx(i,k+1) = gflx(i,k+1) + faloutg(k) * tx3 ! Ice flux - do k = 2,nlev + do k = kminp1,nlev tx5 = dumg(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -4463,8 +4475,9 @@ end subroutine micro_mg_tend !OUTPUT CALCULATIONS !======================================================================== +!! This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) - integer, intent(in) :: mgncol, nlev + integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) real(r8), dimension(mgncol,nlev), intent(in) :: n0r ! rain size parameter (intercept) real(r8), dimension(mgncol,nlev), intent(in) :: lamc ! size distribution parameter (slope) From 87583c85120f2ec23f8a9bf56ed938135462b476 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 6 Nov 2020 20:13:54 -0500 Subject: [PATCH 096/217] some updates in IPD driver --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 128 ++++++++++------ .../GFS_layer/GFS_physics_driver.F90_clean | 143 ++++++++++-------- gfsphysics/physics/micro_mg3_0.F90 | 43 ++---- gfsphysics/physics/sfc_sice.f | 81 +++++----- io/FV3GFS_io.F90 | 5 +- 5 files changed, 221 insertions(+), 179 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 06d731365..241d3dc38 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -61,6 +61,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys ! real(kind=kind_phys), parameter :: huge = 0.0_kind_phys + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice !> GFS Physics Implementation Layer !> @brief Layer that invokes individual GFS physics routines @@ -540,7 +541,7 @@ subroutine GFS_physics_driver & area, land, rain0, snow0, ice0, graupel0 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%lsoil) :: & - smsoil, stsoil, slsoil + smsoil, stsoil, slsoil, stice real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & del, rhc, dtdt, dudt, dvdt, dtdtc, & @@ -814,8 +815,8 @@ subroutine GFS_physics_driver & ! do i=1,im ! lprnt = Model%me == 23 .and. i == 25 ! lprnt = Model%me == 127 .and. i == 11 -! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-295.40) < 0.101 & -! .and. abs(grid%xlat(i)*rad2dg-47.0) < 0.101 +! lprnt = kdt >= 1 .and. abs(grid%xlon(i)*rad2dg-269.15) < 0.201 & +! .and. abs(grid%xlat(i)*rad2dg-57.28) < 0.201 ! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 & ! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301 ! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 & @@ -1070,8 +1071,7 @@ subroutine GFS_physics_driver & fice(i) = Sfcprop%fice(i) !*## CCPP ##* !## CCPP ##* GFS_surface_composites.F90/GFS_surface_composites_pre_run -! tice(i) = Sfcprop%tisfc(i) - tice(i) = zero + tice(i) = Sfcprop%tisfc(i) ! !GFDL work1(i) = (log(coslat(i) / (nlons(i)*latr)) - dxmin) * dxinv !GFS Moorthi thinks this should be area and not dx @@ -1125,7 +1125,7 @@ subroutine GFS_physics_driver & if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. - Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) if (Model%cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -1133,6 +1133,7 @@ subroutine GFS_physics_driver & islmsk(i) = 2 else fice(i) = zero + zice(i) = zero flag_cice(i) = .false. islmsk_cice(i) = 0 islmsk(i) = 0 @@ -1145,9 +1146,10 @@ subroutine GFS_physics_driver & if (fice(i) >= Model%min_lakeice) then icy(i) = .true. islmsk(i) = 2 - Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero islmsk(i) = 0 endif ! islmsk_cice(i) = islmsk(i) @@ -1156,8 +1158,9 @@ subroutine GFS_physics_driver & if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif endif - else + else ! all land fice(i) = zero + zice(i) = zero endif enddo else @@ -1167,16 +1170,19 @@ subroutine GFS_physics_driver & dry(i) = .true. frland(i) = one fice(i) = zero + zice(i) = zero else frland(i) = zero if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero flag_cice(i) = .false. - islmsk_cice(i) = 0 islmsk(i) = 0 + islmsk_cice(i) = 0 endif if (fice(i) < one) then wet(i) = .true. ! some open ocean @@ -1185,8 +1191,10 @@ subroutine GFS_physics_driver & else if (fice(i) >= Model%min_lakeice) then icy(i) = .true. + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero islmsk(i) = 0 endif if (fice(i) < one) then @@ -1290,8 +1298,18 @@ subroutine GFS_physics_driver & smsoil(i,k) = Sfcprop%smc(i,k) stsoil(i,k) = Sfcprop%stc(i,k) slsoil(i,k) = Sfcprop%slc(i,k) !! clu: slc -> slsoil + stice(i,k) = Sfcprop%stc(i,k) enddo enddo + if (Model%frac_grid) then + do k=1,Model%kice + do i=1,im + if (icy(i)) then + stice(i,k) = max(timin, min(Sfcprop%tiice(i,k), tgice)) + endif + enddo + enddo + endif !*## CCPP ## do k=1,levs @@ -1703,7 +1721,7 @@ subroutine GFS_physics_driver & ! ! if (lprnt) write(0,*)' tsfc=',Sfcprop%tsfc(ipr),'iter=', & ! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& -! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:) +! ' zorl3=',zorl3(ipr,:),' uustar3=',uustar3(ipr,:),' stice=',stice(ipr,:) !## CCPP ##* sfc_diff.f/sfc_diff_run call sfc_diff & @@ -1971,7 +1989,7 @@ subroutine GFS_physics_driver & ! if (lprnt) write(0,*)' tseabeficemodel =',Sfcprop%tsfc(ipr),' me=',me & ! &, ' kdt=',kdt,' tsfc32=',tsfc3(ipr,2),' fice=',fice(ipr) & -! &,' stsoil=',stsoil(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) +! &,' stice=',stice(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) ! --- ... surface energy balance over seaice !## CCPP ##* sfc_sice.f/sfc_sice_run (local adjustment to avoid resetting islmsk after call to sfc_sice_run) @@ -2022,6 +2040,8 @@ subroutine GFS_physics_driver & ! enddo ! endif !## CCPP ##* sfc_sice.f/sfc_sice_run +! write(0,*)' me=',me,' mintice=',minval(tice),' maxtice=',maxval(tice),' kdt=',kdt +! if (lprnt) write(0,*)' bef sice stice=',stice(ipr,:) call sfc_sice & ! --- inputs: (im, lsoil, Statein%pgr, & @@ -2030,16 +2050,18 @@ subroutine GFS_physics_driver & gabsbdlw3(:,2), adjsfcnsw, adjsfcdsw, Sfcprop%srflag, & cd3(:,2), cdq3(:,2), & Statein%prsl(:,1), work3, islmsk, wind, & - flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & - Sfcprop%oceanfrac, & + flag_iter, lprnt, ipr, & +! flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & +! Sfcprop%oceanfrac, & ! --- input/output: zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & - stsoil, ep1d3(:,2), & + stice, ep1d3(:,2), & ! --- outputs: snowd3(:,2), qss3(:,2), snowmt, gflx3(:,2), cmm3(:,2), chh3(:,2), & evap3(:,2), hflx3(:,2)) !*## CCPP ## !## CCPP ##* This section is not needed for CCPP. +! if (lprnt) write(0,*)' sft sice stice=',stice(ipr,:) if (Model%frac_grid) then do i = 1, im if (islmsk(i) == 2 .and. fice(i) < one) then @@ -2189,6 +2211,11 @@ subroutine GFS_physics_driver & endif endif enddo + do k=1,Model%kice + do i=1,im + Sfcprop%tiice(i,k) = stice(i,k) + enddo + enddo else do i=1,im if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then @@ -2278,7 +2305,8 @@ subroutine GFS_physics_driver & endif do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case ! Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) - Sfcprop%stc(i,k) = stsoil(i,k) +! Sfcprop%stc(i,k) = stsoil(i,k) + Sfcprop%stc(i,k) = stice(i,k) enddo enddo endif ! if (Model%frac_grid) @@ -2556,7 +2584,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & Model%dspfac, Model%bl_upfr, Model%bl_dnfr) !*## CCPP ## @@ -2570,21 +2598,21 @@ subroutine GFS_physics_driver & Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac) else call moninedmf_hafs(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dqdt,& - Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & - Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & - rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & - Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & - wind, kpbl, Statein%prsi, del, Statein%prsl, & - Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& - gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & - Model%xkzm_s, lprnt, ipr, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac,islmsk) endif ! if (lprnt) write(0,*)' dtdtm=',(dtdt(ipr,k),k=1,15) @@ -2606,7 +2634,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq,& stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac, Model%rbcr) @@ -2618,7 +2646,7 @@ subroutine GFS_physics_driver & Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & Statein%prsi, del, Statein%prsl, Statein%prslk, & Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & - dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & Model%xkzm_m, Model%xkzm_h) else call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dqdt, & @@ -2634,7 +2662,7 @@ subroutine GFS_physics_driver & endif ! end if_do_shoc else !*## CCPP ## -!## CCPP ## These variables are allocated in GFS_typedefs.F90/interstitial_create and +!## CCPP ## These variables are allocated in GFS_typedefs.F90/interstitial_create and ! initialized in GFS_typedefs.F90/interstitial_phys_reset; ntiwx is set in ! GFS_typedef.F90/interstitial_setup_tracers allocate(vdftra(ix,levs,nvdiff), dvdftra(im,levs,nvdiff)) @@ -2780,7 +2808,7 @@ subroutine GFS_physics_driver & Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, & evapq, stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & - dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) !*## CCPP ## @@ -2796,7 +2824,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) !*## CCPP ## elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) @@ -2809,7 +2837,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & Model%dspfac, Model%bl_upfr, Model%bl_dnfr) !*## CCPP ## @@ -2825,11 +2853,11 @@ subroutine GFS_physics_driver & Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac) -!*## CCPP ## +!*## CCPP ## !## CCPP ##* The following schemes are not in the CCPP yet. else call moninedmf_hafs(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dvdftra, & @@ -2839,7 +2867,7 @@ subroutine GFS_physics_driver & Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac,islmsk) @@ -2851,7 +2879,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac, Model%rbcr) @@ -2863,7 +2891,7 @@ subroutine GFS_physics_driver & Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & Statein%prsi, del, Statein%prsl, Statein%prslk, & Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & - dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & Model%xkzm_m, Model%xkzm_h) else call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dvdftra, & @@ -3788,8 +3816,8 @@ subroutine GFS_physics_driver & ! dqdt(1:im,:,3) = Stateout%gq0(1:im,:,ntcw) !GFDL lat has no meaning inside of shoc - changed to "1" !GFDL call shoc(ix, im, 1, levs, levs+1, dtp, me, lat, -! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & -! call shoc (ix, im, 1, levs, levs+1, dtshoc, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtshoc, me, 1, Statein%prsl(1,1),& ! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Staotein%prsl(1,1), & ! write(0,*)' before shoc hflx=',hflxq, ' me=',me ! write(0,*)' before shoc evap=',evapq,' me=',me @@ -3874,7 +3902,7 @@ subroutine GFS_physics_driver & if (Model%do_deep) then !## CCPP ## GFS_DCNV_generic.F90/GFS_DCNV_generic_pre_run Note: The conditional -! above is not checked within the scheme, so the execution of the code below +! above is not checked within the scheme, so the execution of the code below ! is controlled via its presence in the CCPP SDF. !*## CCPP ## @@ -3920,7 +3948,7 @@ subroutine GFS_physics_driver & Model%c1_deep, Model%betal_deep, Model%betas_deep, & Model%evfact_deep, Model%evfactl_deep, & Model%pgcon_deep, Model%asolfac_deep, & - Model%do_ca, Model%ca_closure, Model%ca_entr, & + Model%do_ca, Model%ca_closure, Model%ca_entr, & Model%ca_trigger, Model%nthresh, Coupling%ca_deep, & Coupling%condition) !*## CCPP ## @@ -4139,7 +4167,7 @@ subroutine GFS_physics_driver & !*## CCPP ## else ! no parameterized deep convection -!## CCPP ##* GFS_typedefs.F90/interstitial_phys_reset Note: These are only zeroed out +!## CCPP ##* GFS_typedefs.F90/interstitial_phys_reset Note: These are only zeroed out ! initially, prior to calling physics. cld1d = zero rain1 = zero @@ -4229,7 +4257,7 @@ subroutine GFS_physics_driver & ! endif ! DH* this block is in gwdc_pre -!## CCPP ##* gwdc.f/gwdc_pre Note: The conditional above is not in the scheme, so +!## CCPP ##* gwdc.f/gwdc_pre Note: The conditional above is not in the scheme, so ! the execution of the code below is controlled by its presence in the CCPP SDF ! --- ... calculate maximum convective heating rate if (Model%do_cnvgwd) then ! call convective gravity wave drag @@ -4496,7 +4524,7 @@ subroutine GFS_physics_driver & Stateout%gq0(:,:,1), Stateout%gt0, & Stateout%gu0, Stateout%gv0, Model%fscav, & rain1, kbot, ktop, kcnv, islmsk, garea, & - Statein%vvl, ncld, Tbd%hpbl, ud_mf, & + Statein%vvl, ncld, Tbd%hpbl, ud_mf, & dt_mf, cnvw, cnvc, & Model%clam_shal, Model%c0s_shal, Model%c1_shal, & Model%pgcon_shal, Model%asolfac_shal) @@ -4644,7 +4672,7 @@ subroutine GFS_physics_driver & ! call shoc(im, 1, levs, levs+1, dtp, me, lat, & !! call shoc(im, 1, levs, levs+1, dtshoc, me, lat, & ! & prsl(1:im,:), phii (1:im,:), phil(1:im,:),& -! & gu0(1:im,:),gv0(1:im,:), vvl(1:im,:), gt0(1:im,:), & +! & gu0(1:im,:),gv0(1:im,:), vvl(1:im,:), gt0(1:im,:), & ! & gq0(1:im,:,1), & ! & clw(1:im,:,1), clw(1:im,:,2), qsnw, qrn, sgs_cld(1:im,:)& ! &, gq0(1:im,:,ntke), & @@ -4654,7 +4682,7 @@ subroutine GFS_physics_driver & ! & con_rv, con_rd, con_pi, con_fvirt) !GFDL replace lat with "1: -! call shoc(ix, im, 1, levs, levs+1, dtshoc, me, lat, & +! call shoc(ix, im, 1, levs, levs+1, dtshoc, me, lat, & ! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & call shoc (ix, im, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), del, & Statein%phii(1,1), Statein%phil(1,1), Stateout%gu0(1,1), & @@ -5011,7 +5039,7 @@ subroutine GFS_physics_driver & 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 + Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc enddo enddo elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then @@ -5399,7 +5427,7 @@ subroutine GFS_physics_driver & ! adjust sfc rainrate for conservation ! vertically integrate reduction of water increments, reduce precip by that amount -!## CCPP ##* cs_conv_aw_adj.F90/cs_conv_aw_adj_run Note: The conditional above +!## CCPP ##* cs_conv_aw_adj.F90/cs_conv_aw_adj_run Note: The conditional above ! is not checked in the scheme, so the control of the code below is through its ! inclusion in a CCPP SDF @@ -5897,13 +5925,13 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) dbz1(1) = -35. dbz1(2) = -35. vloopm10: do k=1,levs-1 - if (tk(i,k+1) .le. 263.15 .and. tk(i,k) .ge. 263.15) then + if (tk(i,k+1) .le. 263.15 .and. tk(i,k) .ge. 263.15) then dbz1(1)=ref3d(i,k+1) !- dBZ (not Z) values dbz1(2)=ref3d(i,k) !- dBZ values exit vloopm10 endif enddo vloopm10 - + do ll=1,2 refl=0. if (dbz1(ll)>-35.) refl=10.**(0.1*dbz1(ll)) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean index a3df20f78..0fa591bb7 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -193,16 +193,16 @@ module module_physics_driver ! Jun 2018 J. Han Add scal-aware TKE-based moist EDMF ! ! vertical turbulent mixng scheme ! ! Nov 2018 J. Han Add canopy heat storage parameterization! -! Feb 2019 Ruiyu S. Add an alternate method to use ! +! Feb 2019 Ruiyu S. Add an alternate method to use ! ! hydrometeors from GFDL MP in radiation ! -! Mar 2019 Rongqian &Helin Add Noah MP LSM ! +! Mar 2019 Rongqian &Helin Add Noah MP LSM ! ! Mar 2019 S. Moorthi update slflag for MG3 and update ! ! rain/snow over sea-ice. Update sfc_sice! ! sfc_cice calls ! ! ! Apr 22 2019 S. Moorthi Porting Unified Gravitiy Wave drag ! ! parameterrizaion package from V. Yudin, ! -! J. Alpert, T. Fuller-Rowll and R. Akmaev! +! J. Alpert, T. Fuller-Rowll and R. Akmaev! ! May 2019 J. Han Add updated scal-aware TKE-based moist ! ! EDMF vertical turbulent mixng scheme ! ! july 2019 S. Moorthi Move original GWD to inside of UGW such ! @@ -533,7 +533,7 @@ module module_physics_driver area, land, rain0, snow0, ice0, graupel0 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%lsoil) :: & - smsoil, stsoil, slsoil + smsoil, stsoil, slsoil, stice real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & del, rhc, dtdt, dudt, dvdt, dtdtc, & @@ -653,7 +653,7 @@ module module_physics_driver real :: pshltr,QCQ,rh02 real(kind=kind_phys), allocatable, dimension(:,:) :: den - real(kind=kind_phys) :: lndp_vgf + real(kind=kind_phys) :: lndp_vgf !-------------------------------------------------------------------------------- !! Initialize local variables (for debugging purposes only, @@ -904,16 +904,16 @@ module module_physics_driver lndp_vgf=-999. if (Model%lndp_type==1) then - do k =1,Model%n_var_lndp - select case(Model%lndp_var_list(k)) + do k =1,Model%n_var_lndp + select case(Model%lndp_var_list(k)) case ('rz0') - z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) case ('rzt') - zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) case ('shc') - bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) + bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) case ('lai') - xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) case ('vgf') ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff do i=1,im @@ -1066,7 +1066,7 @@ module module_physics_driver if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. - Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) if (Model%cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -1074,6 +1074,7 @@ module module_physics_driver islmsk(i) = 2 else fice(i) = zero + zice(i) = zero flag_cice(i) = .false. islmsk_cice(i) = 0 islmsk(i) = 0 @@ -1086,9 +1087,10 @@ module module_physics_driver if (fice(i) >= Model%min_lakeice) then icy(i) = .true. islmsk(i) = 2 - Sfcprop%tisfc(i) = min(Sfcprop%tisfc(i), tgice) + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero islmsk(i) = 0 endif ! islmsk_cice(i) = islmsk(i) @@ -1097,8 +1099,9 @@ module module_physics_driver if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) endif endif - else + else ! all land fice(i) = zero + zice(i) = zero endif enddo else @@ -1108,16 +1111,19 @@ module module_physics_driver dry(i) = .true. frland(i) = one fice(i) = zero + zice(i) = zero else frland(i) = zero if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero flag_cice(i) = .false. - islmsk_cice(i) = 0 islmsk(i) = 0 + islmsk_cice(i) = 0 endif if (fice(i) < one) then wet(i) = .true. ! some open ocean @@ -1126,8 +1132,10 @@ module module_physics_driver else if (fice(i) >= Model%min_lakeice) then icy(i) = .true. + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) else fice(i) = zero + zice(i) = zero islmsk(i) = 0 endif if (fice(i) < one) then @@ -1229,8 +1237,18 @@ module module_physics_driver smsoil(i,k) = Sfcprop%smc(i,k) stsoil(i,k) = Sfcprop%stc(i,k) slsoil(i,k) = Sfcprop%slc(i,k) !! clu: slc -> slsoil + stice(i,k) = Sfcprop%stc(i,k) enddo enddo + if (Model%frac_grid) then + do k=1,Model%kice + do i=1,im + if (icy(i)) then + stice(i,k) = max(timin, min(Sfcprop%tiice(i,k), tgice)) + endif + enddo + enddo + endif do k=1,levs do i=1,im @@ -1676,8 +1694,8 @@ module module_physics_driver ! ,' tsfc3=',tsfc3(ipr,3),' tsurf3=',tsurf3(ipr,3), & ! iter ,'wet=',wet(ipr),'dry=',dry(ipr),' icy=',icy(ipr),& ! ' tref=',Sfcprop%tref(ipr),' tgrs=',Statein%tgrs(ipr,1),' qgrs=',Statein%qgrs(ipr,1,1), & -! ' prsl=',Statein%prsl(ipr,1),' cd3=',cd3(ipr,3),' cdq3=',cdq3(ipr,3),' work3=', & -! work3(ipr),' semis3=',semis3(ipr,3),' gabsbdlw3=',gabsbdlw3(ipr,3),' adjsfcnsw=', & +! ' prsl=',Statein%prsl(ipr,1),' cd3=',cd3(ipr,3),' cdq3=',cdq3(ipr,3),' work3=', & +! work3(ipr),' semis3=',semis3(ipr,3),' gabsbdlw3=',gabsbdlw3(ipr,3),' adjsfcnsw=', & ! adjsfcnsw(ipr),' wind=',wind(ipr),' tseal=',tseal(ipr),' xcosz=',xcosz(ipr) call sfc_nst & @@ -1867,7 +1885,7 @@ module module_physics_driver ! if (lprnt) write(0,*)' tseabeficemodel =',Sfcprop%tsfc(ipr),' me=',me & ! &, ' kdt=',kdt,' tsfc32=',tsfc3(ipr,2),' fice=',fice(ipr) & -! &,' stsoil=',stsoil(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) +! &,' stice=',stice(ipr,:),' tsfc33=',tsfc3(ipr,3),' islmsk=',islmsk(ipr) ! --- ... surface energy balance over seaice if (Model%cplflx) then @@ -1920,11 +1938,12 @@ module module_physics_driver gabsbdlw3(:,2), adjsfcnsw, adjsfcdsw, Sfcprop%srflag, & cd3(:,2), cdq3(:,2), & Statein%prsl(:,1), work3, islmsk, wind, & - flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & - Sfcprop%oceanfrac, & + flag_iter, lprnt, ipr, & +! flag_iter, lprnt, ipr, Model%min_lakeice, Model%min_seaice, & +! Sfcprop%oceanfrac, & ! --- input/output: zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & - stsoil, ep1d3(:,2), & + stice, ep1d3(:,2), & ! --- outputs: snowd3(:,2), qss3(:,2), snowmt, gflx3(:,2), cmm3(:,2), chh3(:,2), & evap3(:,2), hflx3(:,2)) @@ -1972,8 +1991,8 @@ module module_physics_driver ! ! Three-way composites (fields from sfc_diff) txl = frland(i) ! land fraction - wfrac = one -txl ! water fraction (ocean/lake) - txi = fice(i)*wfrac ! txi = ice fraction wrt whole cell + wfrac = one - txl ! water fraction (ocean/lake) + txi = fice(i) * wfrac ! txi = ice fraction wrt whole cell txo = max(zero, wfrac - txi) ! txo = open water fraction ! if (i == ipr .and. lprnt) write(0,*)' txl=',txl,' fice=',fice(i),' txi=',txi,& @@ -2064,7 +2083,7 @@ module module_physics_driver ! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array if (icy(i)) then ! return updated lake ice thickness & concentration to global array Sfcprop%hice(i) = zice(i) - Sfcprop%fice(i) = fice(i) + Sfcprop%fice(i) = fice(i) Sfcprop%tisfc(i) = tice(i) else ! this would be over open ocean or land (no ice fraction) Sfcprop%hice(i) = zero @@ -2073,9 +2092,14 @@ module module_physics_driver endif endif enddo + do k=1,Model%kice + do i=1,im + Sfcprop%tiice(i,k) = stice(i,k) + enddo + enddo else do i=1,im - if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then + if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then islmsk(i) = 0 fice(i) = zero endif @@ -2162,7 +2186,8 @@ module module_physics_driver endif do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case ! Sfcprop%stc(i,k) = Sfcprop%tiice(i,k) - Sfcprop%stc(i,k) = stsoil(i,k) +! Sfcprop%stc(i,k) = stsoil(i,k) + Sfcprop%stc(i,k) = stice(i,k) enddo enddo endif ! if (Model%frac_grid) @@ -2382,7 +2407,7 @@ module module_physics_driver Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc,hflxq,& evapq,stress, wind, kpbl, Statein%prsi, del, Statein%prsl,& Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & - dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) ! if (lprnt) then @@ -2408,7 +2433,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiw, ntke, & @@ -2419,7 +2444,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & Model%dspfac, Model%bl_upfr, Model%bl_dnfr) endif @@ -2432,21 +2457,21 @@ module module_physics_driver Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac) else call moninedmf_hafs(ix, im, levs, nvdiff, ntcw, dvdt, dudt, dtdt, dqdt,& - Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & - Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & - rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & - Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & - wind, kpbl, Statein%prsi, del, Statein%prsl, & - Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl,& - gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & - Model%xkzm_s, lprnt, ipr, & + Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & + Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & + wind, kpbl, Statein%prsi, del, Statein%prsl, & + Statein%prslk, Statein%phii, Statein%phil, dtp, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & + Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac,islmsk) endif ! if (lprnt) write(0,*)' dtdtm=',(dtdt(ipr,k),k=1,15) @@ -2468,7 +2493,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq,& stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac, Model%rbcr) @@ -2480,7 +2505,7 @@ module module_physics_driver Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & Statein%prsi, del, Statein%prsl, Statein%prslk, & Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & - dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & Model%xkzm_m, Model%xkzm_h) else call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dqdt, & @@ -2495,7 +2520,7 @@ module module_physics_driver endif ! end if_hybedmf endif ! end if_do_shoc else -! initialized in GFS_typedefs.F90/interstitial_phys_reset; ntiwx is set in +! initialized in GFS_typedefs.F90/interstitial_phys_reset; ntiwx is set in ! GFS_typedef.F90/interstitial_setup_tracers allocate(vdftra(ix,levs,nvdiff), dvdftra(im,levs,nvdiff)) dvdftra(:,:,:) = zero @@ -2636,7 +2661,7 @@ module module_physics_driver Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, & evapq, stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & - dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) else @@ -2650,7 +2675,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) call satmedmfvdifq(ix, im, levs, nvdiff, ntcw, ntiwx, ntkev, & @@ -2661,7 +2686,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, & Model%dspfac, Model%bl_upfr, Model%bl_dnfr) endif @@ -2674,7 +2699,7 @@ module module_physics_driver Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac) @@ -2686,7 +2711,7 @@ module module_physics_driver Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac,islmsk) @@ -2698,7 +2723,7 @@ module module_physics_driver Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, qss, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & gamt, gamq, dkt, kinver, Model%xkzm_m, Model%xkzm_h, & Model%xkzm_s, lprnt, ipr, & Model%xkzminv, Model%moninq_fac, Model%rbcr) @@ -2710,7 +2735,7 @@ module module_physics_driver Sfcprop%tsfc, qss, hflxq, evapq, stress, wind, kpbl, & Statein%prsi, del, Statein%prsl, Statein%prslk, & Statein%phii, Statein%phil, dtp, dusfc1, dvsfc1, & - dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & + dtsfc1, dqsfc1, Tbd%hpbl, gamt, gamq, dkt, kinver, & Model%xkzm_m, Model%xkzm_h) else call moninp(ix, im, levs, nvdiff, dvdt, dudt, dtdt, dvdftra, & @@ -3569,8 +3594,8 @@ module module_physics_driver ! dqdt(1:im,:,3) = Stateout%gq0(1:im,:,ntcw) !GFDL lat has no meaning inside of shoc - changed to "1" !GFDL call shoc(ix, im, 1, levs, levs+1, dtp, me, lat, -! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & -! call shoc (ix, im, 1, levs, levs+1, dtshoc, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & +! call shoc (ix, im, 1, levs, levs+1, dtshoc, me, 1, Statein%prsl(1,1),& ! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Staotein%prsl(1,1), & ! write(0,*)' before shoc hflx=',hflxq, ' me=',me ! write(0,*)' before shoc evap=',evapq,' me=',me @@ -3689,7 +3714,7 @@ module module_physics_driver Model%c1_deep, Model%betal_deep, Model%betas_deep, & Model%evfact_deep, Model%evfactl_deep, & Model%pgcon_deep, Model%asolfac_deep, & - Model%do_ca, Model%ca_closure, Model%ca_entr, & + Model%do_ca, Model%ca_closure, Model%ca_entr, & Model%ca_trigger, Model%nthresh, Coupling%ca_deep, & Coupling%condition) ! if (lprnt) print *,' rain1=',rain1(ipr) @@ -3752,7 +3777,7 @@ module module_physics_driver ! ! JLS NOTE: The convective mass fluxes (dt_mf, dd_mf and ud_mf) passed in and out of cs_conv have not been multiplied by -! the timestep (i.e, the are in kg/m2/sec) as they are in all other convective schemes. EMC is aware of this problem, +! the timestep (i.e, the are in kg/m2/sec) as they are in all other convective schemes. EMC is aware of this problem, ! and in the future will be fixing this discrepancy. In the meantime, CCPP will use the same mass flux standard_name ! and long_name as the other convective schemes, where the units are in kg/m2. (Aug 2018) ! @@ -4221,7 +4246,7 @@ module module_physics_driver Stateout%gq0(:,:,1), Stateout%gt0, & Stateout%gu0, Stateout%gv0, Model%fscav, & rain1, kbot, ktop, kcnv, islmsk, garea, & - Statein%vvl, ncld, Tbd%hpbl, ud_mf, & + Statein%vvl, ncld, Tbd%hpbl, ud_mf, & dt_mf, cnvw, cnvc, & Model%clam_shal, Model%c0s_shal, Model%c1_shal, & Model%pgcon_shal, Model%asolfac_shal) @@ -4361,7 +4386,7 @@ module module_physics_driver ! call shoc(im, 1, levs, levs+1, dtp, me, lat, & !! call shoc(im, 1, levs, levs+1, dtshoc, me, lat, & ! & prsl(1:im,:), phii (1:im,:), phil(1:im,:),& -! & gu0(1:im,:),gv0(1:im,:), vvl(1:im,:), gt0(1:im,:), & +! & gu0(1:im,:),gv0(1:im,:), vvl(1:im,:), gt0(1:im,:), & ! & gq0(1:im,:,1), & ! & clw(1:im,:,1), clw(1:im,:,2), qsnw, qrn, sgs_cld(1:im,:)& ! &, gq0(1:im,:,ntke), & @@ -4371,7 +4396,7 @@ module module_physics_driver ! & con_rv, con_rd, con_pi, con_fvirt) !GFDL replace lat with "1: -! call shoc(ix, im, 1, levs, levs+1, dtshoc, me, lat, & +! call shoc(ix, im, 1, levs, levs+1, dtshoc, me, lat, & ! call shoc (ix, im, 1, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), & call shoc (ix, im, levs, levs+1, dtp, me, 1, Statein%prsl(1,1), del, & Statein%phii(1,1), Statein%phil(1,1), Stateout%gu0(1,1), & @@ -4679,7 +4704,7 @@ module module_physics_driver Stateout%gq0(1:im,1:levs,Model%ntgl), & Statein%prsl, del, dtp, rain1, & Diag%sr, & - islmsk, & + islmsk, & Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3), & ims,ime, kms,kme, & its,ite, kts,kte) @@ -5028,7 +5053,7 @@ module module_physics_driver Diag%refdmax(i) = max(Diag%refdmax(i),refd(i)) Diag%refdmax263k(i) = max(Diag%refdmax263k(i),refd263k(i)) enddo - deallocate (refd) + deallocate (refd) deallocate (refd263k) endif if(Model%effr_in) then @@ -5553,7 +5578,7 @@ module module_physics_driver dbz1(1) = -35. dbz1(2) = -35. vloopm10: do k=1,levs-1 - if (tk(i,k+1) .le. 263.15 .and. tk(i,k) .ge. 263.15) then + if (tk(i,k+1) .le. 263.15 .and. tk(i,k) .ge. 263.15) then dbz1(1)=ref3d(i,k+1) !- dBZ (not Z) values dbz1(2)=ref3d(i,k) !- dBZ values exit vloopm10 diff --git a/gfsphysics/physics/micro_mg3_0.F90 b/gfsphysics/physics/micro_mg3_0.F90 index 773f183c0..b170ccd70 100644 --- a/gfsphysics/physics/micro_mg3_0.F90 +++ b/gfsphysics/physics/micro_mg3_0.F90 @@ -1063,7 +1063,7 @@ subroutine micro_mg_tend ( & integer i, k, n ! number of sub-steps for loops over "n" (for sedimentation) - integer nstep, mdust, nlb, nstep_def, kmin, kminp1 + integer nstep, mdust, nlb, nstep_def ! Varaibles to scale fall velocity between small and regular ice regimes. ! real(r8) :: irad, ifrac, tsfac @@ -1075,11 +1075,6 @@ subroutine micro_mg_tend ( & ! real(r8), parameter :: qimax=0.010, qimin=0.001, qiinv=one/(qimax-qimin), & real(r8), parameter :: qimax=0.010_r8, qimin=0.005_r8, qiinv=one/(qimax-qimin) ! ts_au_min=180.0 - real(r8), parameter :: pmin_sed = 5000.0 ! layer pressure in Pa below which - ! sedimentation calcuation is - ! done -! integer, parameter :: nstep_fac=10 ! factor for definng nstep_def - integer, parameter :: nstep_fac=5 ! factor for definng nstep_def !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc @@ -1089,7 +1084,8 @@ subroutine micro_mg_tend ( & ! assign variable deltat to deltatin deltat = deltatin oneodt = one / deltat - nstep_def = max(1, nint(deltat/nstep_fac)) +! nstep_def = max(1, nint(deltat/20)) + nstep_def = max(1, nint(deltat/5)) ! tsfac = log(ts_au/ts_au_min) * qiinv ! Copies of input concentrations that may be changed internally. @@ -2180,7 +2176,7 @@ subroutine micro_mg_tend ( & ! 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),' ni=',ni(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 @@ -3398,19 +3394,11 @@ subroutine micro_mg_tend ( & tx1 = tx2 * deltat tx3 = tx2 / g - kmin = 1 - do k=2,nlev-1 - if (p(i,k) < pmin_sed) then - kmin = k - endif - enddo - kminp1 = kmin + 1 - do n = 1,nstep ! top of model - k = kmin + k = 1 ! add fallout terms to microphysical tendencies @@ -3431,7 +3419,7 @@ subroutine micro_mg_tend ( & iflx(i,k+1) = iflx(i,k+1) + falouti(k) * tx3 ! Ice flux - do k = kminp1,nlev + do k = 2,nlev ! for cloud liquid and ice, if cloud fraction increases with height ! then add flux from above to both vapor and cloud water of current level @@ -3500,7 +3488,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = kmin + k = 1 tx5 = dumc(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -3519,7 +3507,7 @@ subroutine micro_mg_tend ( & faloutnc(k) = fnc(i,k) * dumnc(i,k) lflx(i,k+1) = lflx(i,k+1) + faloutc(k) * tx3 - do k = kminp1,nlev + do k = 2,nlev if (lcldm(i,k-1) > mincld) then dum1 = max(zero, min(one, lcldm(i,k)/lcldm(i,k-1))) @@ -3583,7 +3571,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = kmin + k = 1 ! add fallout terms to microphysical tendencies @@ -3604,7 +3592,7 @@ subroutine micro_mg_tend ( & rflx(i,k+1) = rflx(i,k+1) + faloutr(k) * tx3 - do k = kminp1,nlev + do k = 2,nlev tx5 = dumr(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -3645,7 +3633,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = kmin + k = 1 ! add fallout terms to microphysical tendencies @@ -3666,7 +3654,7 @@ subroutine micro_mg_tend ( & sflx(i,k+1) = sflx(i,k+1) + falouts(k) * tx3 - do k = kminp1,nlev + do k = 2,nlev tx5 = dums(i,k) @@ -3712,7 +3700,7 @@ subroutine micro_mg_tend ( & do n = 1,nstep ! top of model - k = kmin + k = 1 ! add fallout terms to microphysical tendencies @@ -3733,7 +3721,7 @@ subroutine micro_mg_tend ( & gflx(i,k+1) = gflx(i,k+1) + faloutg(k) * tx3 ! Ice flux - do k = kminp1,nlev + do k = 2,nlev tx5 = dumg(i,k) tx7 = pdel_inv(i,k) * tx1 @@ -4475,9 +4463,8 @@ end subroutine micro_mg_tend !OUTPUT CALCULATIONS !======================================================================== -!! This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) - integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension + integer, intent(in) :: mgncol, nlev real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) real(r8), dimension(mgncol,nlev), intent(in) :: n0r ! rain size parameter (intercept) real(r8), dimension(mgncol,nlev), intent(in) :: lamc ! size distribution parameter (slope) diff --git a/gfsphysics/physics/sfc_sice.f b/gfsphysics/physics/sfc_sice.f index bf66ef23a..2eea2d584 100644 --- a/gfsphysics/physics/sfc_sice.f +++ b/gfsphysics/physics/sfc_sice.f @@ -10,7 +10,7 @@ !> \brief Brief description of the subroutine !! !! \section arg_table_sice_run Arguments -!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! | local var name | longname | description !! |----------------|-------------------------------------------------------|------------------------------------|---------|------|---------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | !! @@ -31,13 +31,14 @@ module module_sfc_sice subroutine sfc_sice & !................................... ! --- inputs: - & ( im, km, ps, t1, q1, delt, & + & ( im, kice, ps, t1, q1, delt, & ! & ( im, km, ps, u1, v1, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, islimsk, wind, & - & flag_iter, lprnt, ipr, min_lakeice, min_seaice, oceanfrac, & + & flag_iter, lprnt, ipr, & +! & flag_iter, lprnt, ipr, min_lakeice, min_seaice, oceanfrac, & ! --- input/outputs: - & hice, fice, tice, weasd, tskin, tprcp, stc, ep, & + & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- outputs: & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx & & ) @@ -49,13 +50,13 @@ subroutine sfc_sice & ! ! ! call sfc_sice ! ! inputs: ! -! ( im, km, ps, t1, q1, delt, ! +! ( im, kice, ps, t1, q1, delt, ! !! ( im, km, ps, u1, v1, t1, q1, delt, ! ! sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, ! ! cm, ch, prsl1, prslki, islimsk, wind, ! ! flag_iter, ! ! input/outputs: ! -! hice, fice, tice, weasd, tskin, tprcp, stc, ep, ! +! hice, fice, tice, weasd, tskin, tprcp, tiice, ep, ! ! outputs: ! ! snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx ) ! ! ! @@ -82,7 +83,7 @@ subroutine sfc_sice & ! ==================== defination of variables ==================== ! ! ! ! inputs: size ! -! im, km - integer, horiz dimension and num of soil layers 1 ! +! im, kice - integer, horiz dimension and num of ice layers 1 ! ! ps - real, surface pressure im ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! @@ -107,7 +108,7 @@ subroutine sfc_sice & ! weasd - real, water equivalent accumulated snow depth (mm)im ! ! tskin - real, ground surface skin temperature ( k ) im ! ! tprcp - real, total precipitation im ! -! stc - real, soil temp (k) im,km ! +! tiice - real, internal ice temperature (k) im,kice ! ! ep - real, potential evaporation im ! ! ! ! outputs: ! @@ -124,7 +125,6 @@ subroutine sfc_sice & ! ! ! --- constant parameters: - integer, parameter :: kmi = 2 ! 2-layer of ice real(kind=kind_phys), parameter :: zero = 0.0_kind_phys real(kind=kind_phys), parameter :: one = 1.0_kind_phys real(kind=kind_phys), parameter :: cpinv = one/cp @@ -139,16 +139,18 @@ subroutine sfc_sice & real(kind=kind_phys), parameter :: qmin = 1.0e-8_kind_phys ! --- inputs: - integer, intent(in) :: im, km, ipr + integer, intent(in) :: im, kice, ipr logical, intent(in) :: lprnt real (kind=kind_phys), dimension(im), intent(in) :: ps, & & t1, q1, sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, cm, ch, & - & prsl1, prslki, wind, oceanfrac + & prsl1, prslki, wind +! & prsl1, prslki, wind, oceanfrac integer, dimension(im), intent(in) :: islimsk - real (kind=kind_phys), intent(in) :: delt, min_lakeice, & - & min_seaice + real (kind=kind_phys), intent(in) :: delt +! real (kind=kind_phys), intent(in) :: delt, min_lakeice, & +! & min_seaice logical, intent(in) :: flag_iter(im) @@ -156,7 +158,7 @@ subroutine sfc_sice & real (kind=kind_phys), dimension(im), intent(inout) :: hice, & & fice, tice, weasd, tskin, tprcp, ep - real (kind=kind_phys), dimension(im,km), intent(inout) :: stc + real (kind=kind_phys), dimension(im,kice), intent(inout) :: tiice ! --- outputs: real (kind=kind_phys), dimension(im), intent(inout) :: snwdph, & @@ -169,8 +171,8 @@ subroutine sfc_sice & & focn, snof, rch, rho, & & snowd, theta1 - real (kind=kind_phys) :: t12, t14, tem, stsice(im,kmi) - &, hflxi, hflxw, q0, qs1, qssi, qssw, cimin + real (kind=kind_phys) :: t12, t14, tem, stsice(im,kice) + &, hflxi, hflxw, q0, qs1, qssi, qssw integer :: i, k @@ -183,10 +185,10 @@ subroutine sfc_sice & do i = 1, im flag(i) = (islimsk(i) == 2) .and. flag_iter(i) - if (flag_iter(i) .and. islimsk(i) < 2) then - hice(i) = zero - fice(i) = zero - endif +! if (flag_iter(i) .and. islimsk(i) < 2) then +! hice(i) = zero +! fice(i) = zero +! endif enddo ! do i = 1, im @@ -200,10 +202,10 @@ subroutine sfc_sice & enddo ! --- ... update sea ice temperature - do k = 1, kmi + do k = 1, kice do i = 1, im if (flag(i)) then - stsice(i,k) = stc(i,k) + stsice(i,k) = tiice(i,k) endif enddo enddo @@ -216,11 +218,11 @@ subroutine sfc_sice & do i = 1, im if (flag(i)) then - if (oceanfrac(i) > zero) then - cimin = min_seaice - else - cimin = min_lakeice - endif +! if (oceanfrac(i) > zero) then +! cimin = min_seaice +! else +! cimin = min_lakeice +! endif ! psurf(i) = 1000.0 * ps(i) ! ps1(i) = 1000.0 * prsl1(i) @@ -235,13 +237,14 @@ subroutine sfc_sice & qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), qmin) q0 = min(qs1, q0) - if (fice(i) < cimin) then - print *,'warning: ice fraction is low:', fice(i) - fice(i) = cimin - tice(i) = tgice - tskin(i)= tgice - print *,'fix ice fraction: reset it to:', fice(i) - endif +! if (fice(i) < cimin) then +! print *,'warning: ice fraction is low:', fice(i) +! fice(i) = cimin +! tice(i) = tgice +! tskin(i)= tgice +! print *,'fix ice fraction: reset it to:', fice(i) +! endif + ffw(i) = one - fice(i) qssi = fpvs(tice(i)) @@ -311,7 +314,7 @@ subroutine sfc_sice & call ice3lay ! --- inputs: ! - & ( im, kmi, fice, flag, hfi, hfd, sneti, focn, delt, ! + & ( im, kice, fice, flag, hfi, hfd, sneti, focn, delt, ! & lprnt, ipr, ! --- outputs: ! & snowd, hice, stsice, tice, snof, snowmt, gflux ) ! @@ -320,14 +323,12 @@ subroutine sfc_sice & if (flag(i)) then if (tice(i) < timin) then print *,'warning: snow/ice temperature is too low:',tice(i) - &, ' i=',i tice(i) = timin print *,'fix snow/ice temperature: reset it to:',tice(i) endif if (stsice(i,1) < timin) then print *,'warning: layer 1 ice temp is too low:',stsice(i,1) - &, ' i=',i stsice(i,1) = timin print *,'fix layer 1 ice temp: reset it to:',stsice(i,1) endif @@ -342,10 +343,10 @@ subroutine sfc_sice & endif enddo - do k = 1, kmi + do k = 1, kice do i = 1, im if (flag(i)) then - stc(i,k) = min(stsice(i,k), t0c) + tiice(i,k) = min(stsice(i,k), t0c) endif enddo enddo @@ -430,7 +431,7 @@ subroutine ice3lay ! input/outputs: ! ! snowd - real, surface pressure im ! ! hice - real, sea-ice thickness im ! -! stsice - real, temp @ midpt of ice levels (deg c) im,kmi! +! stsice - real, temp @ midpt of ice levels (deg c) im,kmi! ! tice - real, surface temperature (deg c) im ! ! snof - real, snowfall rate (m/sec) im ! ! ! diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 458605c96..8f9e365a6 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1221,7 +1221,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) end if do k = 1,Model%kice - Sfcprop(nb)%tiice(ix,k)= sfc_var3ice(i,j,k) !--- internal ice temp + Sfcprop(nb)%tiice(ix,k) = sfc_var3ice(i,j,k) !--- internal ice temp enddo #else !--- 3D variables @@ -2133,11 +2133,12 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) endif -#ifdef CCPP do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature end do +#ifdef CCPP + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then !--- 3D variables do lsoil = 1,Model%lsoil From 9507f7e28b7d8e74aa83aa81e244cc0cec80d644 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 10 Nov 2020 02:10:30 +0000 Subject: [PATCH 097/217] fixing something related to ipd --- io/FV3GFS_io.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 8f9e365a6..4a82c286a 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1220,9 +1220,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo end if - do k = 1,Model%kice - Sfcprop(nb)%tiice(ix,k) = sfc_var3ice(i,j,k) !--- internal ice temp - enddo #else !--- 3D variables do lsoil = 1,Model%lsoil @@ -1248,6 +1245,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif #endif +! internal ice temperature + do k = 1,Model%kice + Sfcprop(nb)%tiice(ix,k) = sfc_var3ice(i,j,k) !--- internal ice temp + enddo + enddo !ix enddo !nb call mpp_error(NOTE, 'gfs_driver:: - after put to container ') From 4eacf6a9eafe335371ea0cfd531514bdf88a65b5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 10 Nov 2020 11:47:39 +0000 Subject: [PATCH 098/217] adding two v17 suites with ras --- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml | 95 +++++++++++++++++++ .../suite_FV3_GFS_v17_cpldnsstrasnoshal.xml | 92 ++++++++++++++++++ 3 files changed, 188 insertions(+), 1 deletion(-) create mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml diff --git a/ccpp/physics b/ccpp/physics index de54bb476..803ceacdc 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit de54bb47609fc32785e6ecc65053545f11dc8c4e +Subproject commit 803ceacdc3b30a0959f444434aadc9576437faab diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml new file mode 100644 index 000000000..4733f2c82 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + satmedmfvdifq + 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 + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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_v17_cpldnsstrasnoshal.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml new file mode 100644 index 000000000..92a4e1e5d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml @@ -0,0 +1,92 @@ + + + + + + + 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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + satmedmfvdifq + 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 + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + From a316a78bcdc0fd3eef28fa2bc87fb01afb3d92fe Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 12 Nov 2020 15:32:06 +0000 Subject: [PATCH 099/217] adding SDF suite_FV3_GFS_v17_cpldnsstsas.xml --- ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml | 94 +++++++++++++++++++ 1 file changed, 94 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml new file mode 100644 index 000000000..32d64d35e --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + satmedmfvdifq + 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 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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 + + + + From 915d21f3fc2784832c19074489e07e611de221a5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 14 Nov 2020 02:02:07 +0000 Subject: [PATCH 100/217] some minor updates --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 40 +++++++++---------- .../GFS_layer/GFS_physics_driver.F90_clean | 15 +++---- io/FV3GFS_io.F90 | 15 +++---- 4 files changed, 37 insertions(+), 35 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 803ceacdc..a0daf0c3b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 803ceacdc3b30a0959f444434aadc9576437faab +Subproject commit a0daf0c3bfcadd575eb03b94016f5a94556e758f diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 241d3dc38..5e37d0016 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -661,7 +661,7 @@ subroutine GFS_physics_driver & real :: pshltr,QCQ,rh02 real(kind=kind_phys), allocatable, dimension(:,:) :: den - real(kind=kind_phys) :: lndp_vgf + real(kind=kind_phys) :: lndp_vgf !! Initialize local variables (for debugging purposes only, !! because the corresponding variables Interstitial(nt)%... !! are reset to zero every time). @@ -933,17 +933,17 @@ subroutine GFS_physics_driver & lndp_vgf=-999. if (Model%lndp_type==1) then - do k =1,Model%n_var_lndp - select case(Model%lndp_var_list(k)) - case ('rz0') - z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('rzt') - zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('shc') - bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) - case ('lai') - xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('vgf') + do k =1,Model%n_var_lndp + select case(Model%lndp_var_list(k)) + case ('rz0') + z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('rzt') + zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('shc') + bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) + case ('lai') + xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) + case ('vgf') ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff do i=1,im call cdfnor(Coupling%sfc_wts(i,k),cdfz) @@ -2055,7 +2055,7 @@ subroutine GFS_physics_driver & ! Sfcprop%oceanfrac, & ! --- input/output: zice, fice, tice, weasd3(:,2), tsfc3(:,2), tprcp3(:,2), & - stice, ep1d3(:,2), & + stice, ep1d3(:,2), & ! --- outputs: snowd3(:,2), qss3(:,2), snowmt, gflx3(:,2), cmm3(:,2), chh3(:,2), & evap3(:,2), hflx3(:,2)) @@ -2202,7 +2202,7 @@ subroutine GFS_physics_driver & ! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array if (icy(i)) then ! return updated lake ice thickness & concentration to global array Sfcprop%hice(i) = zice(i) - Sfcprop%fice(i) = fice(i) + Sfcprop%fice(i) = fice(i) Sfcprop%tisfc(i) = tice(i) else ! this would be over open ocean or land (no ice fraction) Sfcprop%hice(i) = zero @@ -2218,7 +2218,7 @@ subroutine GFS_physics_driver & enddo else do i=1,im - if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then + if (flag_cice(i) .and. wet(i) .and. fice(i) < Model%min_seaice) then islmsk(i) = 0 fice(i) = zero endif @@ -2544,7 +2544,7 @@ subroutine GFS_physics_driver & Diag%v10m, Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc,hflxq,& evapq,stress, wind, kpbl, Statein%prsi, del, Statein%prsl,& Statein%prslk, Statein%phii, Statein%phil, dtp, dusfc1, & - dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & + dvsfc1, dtsfc1, dqsfc1, dkt, Tbd%hpbl, kinver, & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, Model%xkzminv, & lprnt, ipr, me) ! if (lprnt) then @@ -2571,7 +2571,7 @@ subroutine GFS_physics_driver & Sfcprop%ffmm, Sfcprop%ffhh, Sfcprop%tsfc, hflxq, evapq, & stress, wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & - Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & + Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Tbd%hpbl, & kinver, Model%xkzm_m, Model%xkzm_h, Model%xkzm_s) !*## CCPP ## elseif (Model%isatmedmf == 1) then ! updated version of satmedmfvdif (May 2019) @@ -4018,7 +4018,7 @@ subroutine GFS_physics_driver & ! ! JLS NOTE: The convective mass fluxes (dt_mf, dd_mf and ud_mf) passed in and out of cs_conv have not been multiplied by -! the timestep (i.e, the are in kg/m2/sec) as they are in all other convective schemes. EMC is aware of this problem, +! the timestep (i.e, the are in kg/m2/sec) as they are in all other convective schemes. EMC is aware of this problem, ! and in the future will be fixing this discrepancy. In the meantime, CCPP will use the same mass flux standard_name ! and long_name as the other convective schemes, where the units are in kg/m2. (Aug 2018) ! @@ -5014,7 +5014,7 @@ subroutine GFS_physics_driver & Stateout%gq0(1:im,1:levs,Model%ntgl), & Statein%prsl, del, dtp, rain1, & Diag%sr, & - islmsk, & + islmsk, & Tbd%phy_f3d(:,:,1),Tbd%phy_f3d(:,:,2),Tbd%phy_f3d(:,:,3), & ims,ime, kms,kme, & its,ite, kts,kte) @@ -5377,7 +5377,7 @@ subroutine GFS_physics_driver & Diag%refdmax(i) = max(Diag%refdmax(i),refd(i)) Diag%refdmax263k(i) = max(Diag%refdmax263k(i),refd263k(i)) enddo - deallocate (refd) + deallocate (refd) deallocate (refd263k) endif !*## CCPP ## diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean index 0fa591bb7..82f973b3e 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -61,6 +61,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: rad2dg = 180.0_kind_phys/con_pi real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys ! real(kind=kind_phys), parameter :: huge = 0.0_kind_phys + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice !> GFS Physics Implementation Layer !> @brief Layer that invokes individual GFS physics routines @@ -906,15 +907,15 @@ module module_physics_driver if (Model%lndp_type==1) then do k =1,Model%n_var_lndp select case(Model%lndp_var_list(k)) - case ('rz0') + case ('rz0') z01d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('rzt') + case ('rzt') zt1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('shc') + case ('shc') bexp1d(:) = Model%lndp_prt_list(k) * Coupling%sfc_wts(:,k) - case ('lai') + case ('lai') xlai1d(:) = Model%lndp_prt_list(k)* Coupling%sfc_wts(:,k) - case ('vgf') + case ('vgf') ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff do i=1,im call cdfnor(Coupling%sfc_wts(i,k),cdfz) @@ -1066,7 +1067,7 @@ module module_physics_driver if (Sfcprop%oceanfrac(i) > zero) then if (fice(i) >= Model%min_seaice) then icy(i) = .true. - Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) + Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) if (Model%cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -4725,7 +4726,7 @@ module module_physics_driver 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 + Tbd%phy_f3d(i,k,1) = Tbd%phy_f3d(i,k,ntot3d-2) ! clouds from shoc enddo enddo elseif (abs(Model%fprcp) == 1 .or. mg3_as_mg2) then diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 4a82c286a..49df6cd9b 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -70,11 +70,11 @@ module FV3GFS_io_mod #endif !--- GFDL filenames - character(len=32) :: fn_oro = 'oro_data.nc' + character(len=32) :: fn_oro = 'oro_data.nc' character(len=32) :: fn_oro_ls = 'oro_data_ls.nc' character(len=32) :: fn_oro_ss = 'oro_data_ss.nc' - character(len=32) :: fn_srf = 'sfc_data.nc' - character(len=32) :: fn_phy = 'phy_data.nc' + character(len=32) :: fn_srf = 'sfc_data.nc' + character(len=32) :: fn_phy = 'phy_data.nc' !--- GFDL FMS netcdf restart data types type(restart_file_type) :: Oro_restart, Sfc_restart, Phy_restart @@ -112,6 +112,7 @@ module FV3GFS_io_mod real, parameter:: stndrd_atmos_ps = 101325.0_r8 real, parameter:: stndrd_atmos_lapse = 0.0065_r8 real, parameter:: drythresh = 1.e-4_r8, zero = 0.0_r8, one = 1.0_r8 + real(kind=kind_phys), parameter :: timin = 173.0_r8 ! minimum temperature allowed for snow/ice !--- miscellaneous other variables logical :: use_wrtgridcomp_output = .FALSE. @@ -1403,12 +1404,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif ! if (Model%frac_grid) !#ifdef CCPP - if (nint(sfc_var3ice(1,1,1)) == -9999) then + if (nint(sfc_var3ice(1,1,1)) == -9999) then !--- initialize internal ice temp from layer 1 and 2 soil temp if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tiice(ix,1) = Sfcprop(nb)%stc(ix,1) !--- initialize internal ice temp from soil temp at layer 1 - Sfcprop(nb)%tiice(ix,2) = Sfcprop(nb)%stc(ix,2) !--- initialize internal ice temp from soil temp at layer 2 + Sfcprop(nb)%tiice(ix,1) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,1))) + Sfcprop(nb)%tiice(ix,2) = max(timin, min(con_tice, Sfcprop(nb)%stc(ix,2))) enddo enddo endif @@ -2137,7 +2138,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature - end do + enddo #ifdef CCPP From 6602b698fd493f5ac754be025b2bde3ac70edcbd Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 14 Nov 2020 02:03:40 +0000 Subject: [PATCH 101/217] adding some v17 SDFs --- ccpp/suites/suite_FV3_GFS_v17_ras.xml | 94 +++++++++++++++++++++++++++ ccpp/suites/suite_FV3_GFS_v17_sas.xml | 93 ++++++++++++++++++++++++++ 2 files changed, 187 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFS_v17_ras.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v17_sas.xml diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras.xml b/ccpp/suites/suite_FV3_GFS_v17_ras.xml new file mode 100644 index 000000000..5f3aaf00b --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_ras.xml @@ -0,0 +1,94 @@ + + + + + + + fv_sat_adj + + / + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + 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 + GFS_DCNV_generic_pre + GFS_suite_interstitial_5 + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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_v17_sas.xml b/ccpp/suites/suite_FV3_GFS_v17_sas.xml new file mode 100644 index 000000000..3af18fac4 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_sas.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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + 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 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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 + + + + From 3e344f092743cd1d0a5e5d72affc43c4fbee21bc Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 16 Nov 2020 00:05:20 +0000 Subject: [PATCH 102/217] commenting a line in fv3gfs_io and a minot update in gcycle --- ccpp/physics | 2 +- gfsphysics/physics/gcycle.F90 | 5 ++++- io/FV3GFS_io.F90 | 2 +- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index a0daf0c3b..64028eb51 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a0daf0c3bfcadd575eb03b94016f5a94556e758f +Subproject commit 64028eb511878ae49a9e3d0c5eb15953ace9c47b diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index 64d234091..4813e0a7d 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -3,7 +3,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! ! USE MACHINE, only: kind_phys - USE PHYSCONS, only: PI => con_PI + USE PHYSCONS, only: PI => con_PI, con_tice USE GFS_typedefs, only: GFS_control_type, GFS_grid_type, & GFS_sfcprop_type, GFS_cldprop_type implicit none @@ -213,6 +213,9 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) else Sfcprop(nb)%tsfc(ix) = TSFFCS (len) Sfcprop(nb)%tsfco(ix) = TSFFCS (len) + if (slifcs(len) > 1.9_kind_phys) then + Sfcprop(nb)%tsfco(ix) = con_tice + endif endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorll (ix) = ZORFCS (len) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 49df6cd9b..f890f1c1e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1347,7 +1347,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !$omp parallel do default(shared) private(nb, ix, tem, tem1) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) +! Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) tem1 = one - Sfcprop(nb)%landfrac(ix) tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & From 99793e1627ccbf87bbf342ae5ffbcb18213bef4a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 19 Nov 2020 12:30:15 +0000 Subject: [PATCH 103/217] some updates to io and physics driver --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 2 + gfsphysics/GFS_layer/GFS_typedefs.F90 | 135 ++++++++++- io/FV3GFS_io.F90 | 247 +++++++++++++------- 3 files changed, 296 insertions(+), 88 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 5e37d0016..7839ce70e 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1161,6 +1161,8 @@ subroutine GFS_physics_driver & else ! all land fice(i) = zero zice(i) = zero + islmsk(i) = 1 + islmsk_cice(i) = 1 endif enddo else diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index b3e63c794..bd3afb00a 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -250,6 +250,8 @@ module GFS_typedefs 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 + real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m + real (kind=kind_phys), pointer :: semisbase(:) => null() !< background surface emissivity !--- In (radiation only) real (kind=kind_phys), pointer :: sncovr (:) => null() !< snow cover in fraction @@ -337,7 +339,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smoiseq (:,:) => null() !< real (kind=kind_phys), pointer :: zsnsoxy (:,:) => null() !< - +! -- In/Out for HWRF NOAH LSM + real (kind=kind_phys), pointer :: snotime (:) => null() !--- NSSTM variables (only allocated when [Model%nstf_name(1) > 0]) real (kind=kind_phys), pointer :: tref (:) => null() !< nst_fld%Tref - Reference Temperature @@ -775,6 +778,7 @@ module GFS_typedefs integer :: lsm_noah=1 !< flag for NOAH land surface model integer :: lsm_noahmp=2 !< flag for NOAH land surface model integer :: lsm_ruc=3 !< flag for RUC land surface model + integer :: lsm_noah_wrfv4 = 4 !< flag for NOAH land surface from WRF v4.0 integer :: lsoil !< number of soil layers integer :: kice=2 !< number of layers in sice #ifdef CCPP @@ -1690,6 +1694,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: alb1d(:) => null() !< real (kind=kind_phys), pointer :: alpha(:,:) => null() !< real (kind=kind_phys), pointer :: bexp1d(:) => null() !< + real (kind=kind_phys), pointer :: canopy_save(:) => null() !< real (kind=kind_phys), pointer :: cd(:) => null() !< real (kind=kind_phys), pointer :: cd_ice(:) => null() !< real (kind=kind_phys), pointer :: cd_land(:) => null() !< @@ -1702,6 +1707,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: chh_ice(:) => null() !< real (kind=kind_phys), pointer :: chh_land(:) => null() !< real (kind=kind_phys), pointer :: chh_ocean(:) => null() !< + real (kind=kind_phys), pointer :: chk_land(:) => null() !< real (kind=kind_phys), pointer :: clcn(:,:) => null() !< real (kind=kind_phys), pointer :: cldf(:) => null() !< real (kind=kind_phys), pointer :: cldsa(:,:) => null() !< @@ -1712,6 +1718,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: clw(:,:,:) => null() !< real (kind=kind_phys), pointer :: clw_surf(:) => null() !< real (kind=kind_phys), pointer :: clx(:,:) => null() !< + real (kind=kind_phys), pointer :: cmc(:) => null() !< real (kind=kind_phys), pointer :: cmm_ice(:) => null() !< real (kind=kind_phys), pointer :: cmm_land(:) => null() !< real (kind=kind_phys), pointer :: cmm_ocean(:) => null() !< @@ -1734,8 +1741,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dkt(:,:) => null() !< real (kind=kind_phys), pointer :: dlength(:) => null() !< real (kind=kind_phys), pointer :: dqdt(:,:,:) => null() !< + real (kind=kind_phys), pointer :: dqsdt2(:) => null() !< real (kind=kind_phys), pointer :: dqsfc1(:) => null() !< real (kind=kind_phys), pointer :: drain(:) => null() !< + real (kind=kind_phys), pointer :: drain_in_m_sm1(:) => null() !< real (kind=kind_phys), pointer :: dtdt(:,:) => null() !< real (kind=kind_phys), pointer :: dtdtc(:,:) => null() !< real (kind=kind_phys), pointer :: dtsfc1(:) => null() !< @@ -1772,6 +1781,8 @@ module GFS_typedefs logical, pointer :: flag_cice(:) => null() !< logical, pointer :: flag_guess(:) => null() !< logical, pointer :: flag_iter(:) => null() !< + logical, pointer :: flag_lsm(:) => null() !< + logical, pointer :: flag_lsm_glacier(:)=> null() !< real (kind=kind_phys), pointer :: ffmm_ice(:) => null() !< real (kind=kind_phys), pointer :: ffmm_land(:) => null() !< real (kind=kind_phys), pointer :: ffmm_ocean(:) => null() !< @@ -1882,6 +1893,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: qss_ice(:) => null() !< real (kind=kind_phys), pointer :: qss_land(:) => null() !< real (kind=kind_phys), pointer :: qss_ocean(:) => null() !< + real (kind=kind_phys), pointer :: qs1(:) => null() !< + real (kind=kind_phys), pointer :: qv1(:) => null() !< logical :: radar_reset !< real (kind=kind_phys) :: raddt !< real (kind=kind_phys), pointer :: rainmp(:) => null() !< @@ -1895,7 +1908,9 @@ module GFS_typedefs real (kind=kind_phys), pointer :: rb_ocean(:) => null() !< logical :: reset !< real (kind=kind_phys), pointer :: rhc(:,:) => null() !< + real (kind=kind_phys), pointer :: rho1(:) => null() !< real (kind=kind_phys), pointer :: runoff(:) => null() !< + real (kind=kind_phys), pointer :: runoff_in_m_sm1(:) => null() !< real (kind=kind_phys), pointer :: save_q(:,:,:) => null() !< real (kind=kind_phys), pointer :: save_t(:,:) => null() !< real (kind=kind_phys), pointer :: save_tcp(:,:) => null() !< @@ -1912,15 +1927,26 @@ module GFS_typedefs real (kind=kind_phys), pointer :: sigmafrac(:,:) => null() !< real (kind=kind_phys), pointer :: sigmatot(:,:) => null() !< logical :: skip_macro !< + real (kind=kind_phys), pointer :: slc_save(:,:) => null() !< integer, pointer :: slopetype(:) => null() !< + real (kind=kind_phys), pointer :: smcmax(:) => null() !< + real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< real (kind=kind_phys), pointer :: snowd_land(:) => null() !< + real (kind=kind_phys), pointer :: snowd_land_save(:) => null() !< real (kind=kind_phys), pointer :: snowd_ocean(:) => null() !< + real (kind=kind_phys), pointer :: snow_depth(:) => null() !< real (kind=kind_phys), pointer :: snohf(:) => null() !< + real (kind=kind_phys), pointer :: snohf_snow(:) => null() !< + real (kind=kind_phys), pointer :: snohf_frzgra(:) => null() !< + real (kind=kind_phys), pointer :: snohf_snowmelt(:) => null() !< real (kind=kind_phys), pointer :: snowmp(:) => null() !< real (kind=kind_phys), pointer :: snowmt(:) => null() !< + real (kind=kind_phys), pointer :: soilm_in_m(:) => null() !< integer, pointer :: soiltype(:) => null() !< + real (kind=kind_phys), pointer :: stc_save(:,:) => null() !< + real (kind=kind_phys), pointer :: sthick (:) => null() !< real (kind=kind_phys), pointer :: stress(:) => null() !< real (kind=kind_phys), pointer :: stress_ice(:) => null() !< real (kind=kind_phys), pointer :: stress_land(:) => null() !< @@ -1928,11 +1954,13 @@ module GFS_typedefs real (kind=kind_phys), pointer :: t2mmp(:) => null() !< real (kind=kind_phys), pointer :: theta(:) => null() !< real (kind=kind_phys), pointer :: tice(:) => null() !< + real (kind=kind_phys), pointer :: th1(:) => null() !< real (kind=kind_phys), pointer :: tlvl(:,:) => null() !< real (kind=kind_phys), pointer :: tlyr(:,:) => null() !< real (kind=kind_phys), pointer :: tprcp_ice(:) => null() !< real (kind=kind_phys), pointer :: tprcp_land(:) => null() !< real (kind=kind_phys), pointer :: tprcp_ocean(:) => null() !< + real (kind=kind_phys), pointer :: tprcp_rate_land(:) => null() !< integer :: tracers_start_index !< integer :: tracers_total !< integer :: tracers_water !< @@ -1942,6 +1970,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tsfa(:) => null() !< real (kind=kind_phys), pointer :: tsfc_ice(:) => null() !< real (kind=kind_phys), pointer :: tsfc_land(:) => null() !< + real (kind=kind_phys), pointer :: tsfc_land_save(:) => null() !< real (kind=kind_phys), pointer :: tsfc_ocean(:) => null() !< real (kind=kind_phys), pointer :: tsfg(:) => null() !< real (kind=kind_phys), pointer :: tsnow(:) => null() !< @@ -1962,6 +1991,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: wcbmax(:) => null() !< real (kind=kind_phys), pointer :: weasd_ocean(:) => null() !< real (kind=kind_phys), pointer :: weasd_land(:) => null() !< + real (kind=kind_phys), pointer :: weasd_land_save(:) => null() !< real (kind=kind_phys), pointer :: weasd_ice(:) => null() !< real (kind=kind_phys), pointer :: wind(:) => null() !< real (kind=kind_phys), pointer :: work1(:) => null() !< @@ -2506,6 +2536,22 @@ subroutine sfcprop_create (Sfcprop, IM, Model) endif #ifdef CCPP + ! HWRF NOAH LSM allocate and init when used + ! + if (Model%lsm == Model%lsm_noah_wrfv4 ) then + allocate(Sfcprop%snotime(IM)) + Sfcprop%snotime = clear_val + end if + + if (Model%do_myjsfc.or.Model%do_myjpbl.or.(Model%lsm == Model%lsm_noah_wrfv4)) then + allocate(Sfcprop%z0base(IM)) + Sfcprop%z0base = clear_val + end if + if (Model%lsm == Model%lsm_noah_wrfv4) then + allocate(Sfcprop%semisbase(IM)) + Sfcprop%semisbase = clear_val + end if + if (Model%lsm == Model%lsm_ruc) then ! For land surface models with different numbers of levels than the four NOAH levels allocate (Sfcprop%wetness (IM)) @@ -3800,8 +3846,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lsoil = lsoil #ifdef CCPP ! Consistency check for RUC LSM - if (Model%lsm == Model%lsm_ruc .and. Model%nscyc>0) then - write(0,*) 'Logic error: RUC LSM cannot be used with surface data cycling at this point (fhcyc>0)' + if ((Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noah_wrfv4) .and. Model%nscyc>0) then + write(0,*) 'Logic error: RUC LSM and NOAH WRFv4 LSM cannot be used with surface data cycling at this point (fhcyc>0)' stop end if ! Flag to read leaf area index from input files (initial conditions) @@ -4347,6 +4393,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & #ifdef CCPP elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model used' + elseif (Model%lsm == Model%lsm_noah_wrfv4) then + print *,' NOAH WRFv4 Land Surface Model used' #else elseif (Model%lsm == Model%lsm_ruc) then print *,' RUC Land Surface Model only available through CCPP - job aborted' @@ -6546,6 +6594,34 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%t2mmp (IM)) allocate (Interstitial%q2mp (IM)) end if + if (Model%lsm == Model%lsm_noah_wrfv4) then + allocate (Interstitial%canopy_save (IM)) + allocate (Interstitial%chk_land (IM)) + allocate (Interstitial%cmc (IM)) + allocate (Interstitial%dqsdt2 (IM)) + allocate (Interstitial%drain_in_m_sm1 (IM)) + allocate (Interstitial%flag_lsm (IM)) + allocate (Interstitial%flag_lsm_glacier(IM)) + allocate (Interstitial%qs1 (IM)) + allocate (Interstitial%qv1 (IM)) + allocate (Interstitial%rho1 (IM)) + allocate (Interstitial%runoff_in_m_sm1 (IM)) + allocate (Interstitial%slc_save (IM,Model%lsoil)) + allocate (Interstitial%smcmax (IM)) + allocate (Interstitial%smc_save (IM,Model%lsoil)) + allocate (Interstitial%snowd_land_save (IM)) + allocate (Interstitial%snow_depth (IM)) + allocate (Interstitial%snohf_snow (IM)) + allocate (Interstitial%snohf_frzgra (IM)) + allocate (Interstitial%snohf_snowmelt (IM)) + allocate (Interstitial%soilm_in_m (IM)) + allocate (Interstitial%stc_save (IM,Model%lsoil)) + allocate (Interstitial%sthick (Model%lsoil)) + allocate (Interstitial%th1 (IM)) + allocate (Interstitial%tprcp_rate_land (IM)) + allocate (Interstitial%tsfc_land_save (IM)) + allocate (Interstitial%weasd_land_save (IM)) + end if ! ! Set components that do not change Interstitial%frain = Model%dtf/Model%dtp @@ -7118,6 +7194,34 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%t2mmp = clear_val Interstitial%q2mp = clear_val end if + if (Model%lsm == Model%lsm_noah_wrfv4) then + Interstitial%canopy_save = clear_val + Interstitial%chk_land = huge + Interstitial%cmc = clear_val + Interstitial%dqsdt2 = clear_val + Interstitial%drain_in_m_sm1 = clear_val + Interstitial%flag_lsm = .false. + Interstitial%flag_lsm_glacier= .false. + Interstitial%qs1 = huge + Interstitial%qv1 = huge + Interstitial%rho1 = clear_val + Interstitial%runoff_in_m_sm1 = clear_val + Interstitial%slc_save = clear_val + Interstitial%smcmax = clear_val + Interstitial%smc_save = clear_val + Interstitial%snowd_land_save = huge + Interstitial%snow_depth = clear_val + Interstitial%snohf_snow = clear_val + Interstitial%snohf_frzgra = clear_val + Interstitial%snohf_snowmelt = clear_val + Interstitial%soilm_in_m = clear_val + Interstitial%stc_save = clear_val + Interstitial%sthick = clear_val + Interstitial%th1 = clear_val + Interstitial%tprcp_rate_land = huge + Interstitial%tsfc_land_save = huge + Interstitial%weasd_land_save = huge + end if ! ! Set flag for resetting maximum hourly output fields Interstitial%reset = mod(Model%kdt-1, nint(Model%avg_max_length/Model%dtp)) == 0 @@ -7480,6 +7584,31 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%t2mmp ) = ', sum(Interstitial%t2mmp ) write (0,*) 'sum(Interstitial%q2mp ) = ', sum(Interstitial%q2mp ) end if + if (Model%lsm == Model%lsm_noah_wrfv4) then + write (0,*) 'sum(Interstitial%canopy_save ) = ', sum(Interstitial%canopy_save ) + write (0,*) 'sum(Interstitial%chk_land ) = ', sum(Interstitial%chk_land ) + write (0,*) 'sum(Interstitial%cmc ) = ', sum(Interstitial%cmc ) + write (0,*) 'sum(Interstitial%dqsdt2 ) = ', sum(Interstitial%dqsdt2 ) + write (0,*) 'sum(Interstitial%drain_in_m_sm1 ) = ', sum(Interstitial%drain_in_m_sm1 ) + write (0,*) 'Interstitial%flag_lsm(1) = ', Interstitial%flag_lsm(1) + write (0,*) 'Interstitial%flag_lsm_glacier(1) = ', Interstitial%flag_lsm_glacier(1) + write (0,*) 'sum(Interstitial%qs1 ) = ', sum(Interstitial%qs1 ) + write (0,*) 'sum(Interstitial%qv1 ) = ', sum(Interstitial%qv1 ) + write (0,*) 'sum(Interstitial%rho1 ) = ', sum(Interstitial%rho1 ) + write (0,*) 'sum(Interstitial%runoff_in_m_sm1 ) = ', sum(Interstitial%runoff_in_m_sm1 ) + write (0,*) 'sum(Interstitial%smcmax ) = ', sum(Interstitial%smcmax ) + write (0,*) 'sum(Interstitial%snowd_land_save ) = ', sum(Interstitial%snowd_land_save ) + write (0,*) 'sum(Interstitial%snow_depth ) = ', sum(Interstitial%snow_depth ) + write (0,*) 'sum(Interstitial%snohf_snow ) = ', sum(Interstitial%snohf_snow ) + write (0,*) 'sum(Interstitial%snohf_frzgra ) = ', sum(Interstitial%snohf_frzgra ) + write (0,*) 'sum(Interstitial%snohf_snowmelt ) = ', sum(Interstitial%snohf_snowmelt ) + write (0,*) 'sum(Interstitial%soilm_in_m ) = ', sum(Interstitial%soilm_in_m ) + write (0,*) 'sum(Interstitial%sthick ) = ', sum(Interstitial%sthick ) + write (0,*) 'sum(Interstitial%th1 ) = ', sum(Interstitial%th1 ) + write (0,*) 'sum(Interstitial%tprcp_rate_land ) = ', sum(Interstitial%tprcp_rate_land ) + write (0,*) 'sum(Interstitial%tsfc_land_save ) = ', sum(Interstitial%tsfc_land_save ) + write (0,*) 'sum(Interstitial%weasd_land_save ) = ', sum(Interstitial%weasd_land_save ) + end if ! RRTMGP if (Model%do_RRTMGP) then write (0,*) 'sum(Interstitial%aerosolslw ) = ', sum(Interstitial%aerosolslw ) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index f890f1c1e..791b6d633 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -112,6 +112,7 @@ module FV3GFS_io_mod real, parameter:: stndrd_atmos_ps = 101325.0_r8 real, parameter:: stndrd_atmos_lapse = 0.0065_r8 real, parameter:: drythresh = 1.e-4_r8, zero = 0.0_r8, one = 1.0_r8 + real, parameter:: min_lake_orog = 200.0_r8 real(kind=kind_phys), parameter :: timin = 173.0_r8 ! minimum temperature allowed for snow/ice !--- miscellaneous other variables @@ -215,8 +216,8 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) do j=jsc,jec do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) !--- statein pressure temp2d(i,j, 1) = IPD_Data(nb)%Statein%pgr(ix) temp2d(i,j, 2) = IPD_Data(nb)%Sfcprop%slmsk(ix) @@ -253,7 +254,7 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) temp2d(i,j,33) = IPD_Data(nb)%Sfcprop%tprcp(ix) temp2d(i,j,34) = IPD_Data(nb)%Sfcprop%srflag(ix) #ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then #endif temp2d(i,j,35) = IPD_Data(nb)%Sfcprop%slc(ix,1) temp2d(i,j,36) = IPD_Data(nb)%Sfcprop%slc(ix,2) @@ -331,7 +332,7 @@ subroutine FV3GFS_IPD_checksum (Model, IPD_Data, Atm_block) temp2d(i,j,85) = IPD_Data(nb)%Sfcprop%tiice(ix,1) temp2d(i,j,86) = IPD_Data(nb)%Sfcprop%tiice(ix,2) - idx_opt = 87 + idx_opt = 87 if (Model%lsm == Model%lsm_noahmp) then temp2d(i,j,idx_opt) = IPD_Data(nb)%Sfcprop%snowxy(ix) temp2d(i,j,idx_opt+1) = IPD_Data(nb)%Sfcprop%tvxy(ix) @@ -467,19 +468,19 @@ end subroutine FV3GFS_IPD_checksum ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! sfc_prop_restart_read -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! creates and populates a data type which is then used to "register" ! restart variables with the GFDL FMS restart subsystem. ! calls a GFDL FMS routine to restore the data from a restart file. ! calculates sncovr if it is not present in the restart file. ! ! calls: register_restart_field, restart_state, free_restart -! +! ! opens: oro_data.tile?.nc, sfc_data.tile?.nc ! -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- #ifdef CCPP subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start) #else @@ -636,6 +637,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%oro(ix) = oro_var2(i,j,15) !--- oro_uf Sfcprop(nb)%oro_uf(ix) = oro_var2(i,j,16) + + Sfcprop(nb)%landfrac(ix) = -9999.0 + Sfcprop(nb)%lakefrac(ix) = -9999.0 + Sfcprop(nb)%landfrac(ix) = oro_var2(i,j,17) !land frac [0:1] Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] @@ -658,7 +663,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) call free_restart_type(Oro_restart) #ifdef CCPP - !--- Modify/read-in additional orographic static fields for GSL drag suite + !--- Modify/read-in additional orographic static fields for GSL drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33) then if (.not. allocated(oro_ls_ss_name)) then !--- allocate the various containers needed for orography data @@ -742,7 +747,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r),sfc_var3ice(nx,ny,Model%kice)) - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar_s3)) else if (Model%lsm == Model%lsm_ruc) then allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar_s3)) @@ -811,7 +816,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) sfc_name2(nvar_s2m) = 'zorlw' !zorl on land portion of a cell endif - !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) + !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) sfc_name2(nvar_s2m+1) = 'tref' sfc_name2(nvar_s2m+2) = 'z_c' sfc_name2(nvar_s2m+3) = 'c_0' @@ -921,7 +926,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) #ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' sfc_name3(2) = 'smc' @@ -1059,36 +1064,108 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%zorlw(ix) = Sfcprop(nb)%zorlo(ix) endif - if(Model%frac_grid) then ! obtain slmsk from landfrac +!------------------------------------------------- +! if(Model%frac_grid) then ! obtain slmsk from landfrac !! next 5 lines are temporary till lake model is available - if (Sfcprop(nb)%lakefrac(ix) > zero) then -! Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) - if (Sfcprop(nb)%lakefrac(ix) == zero) Sfcprop(nb)%fice(ix) = zero - endif - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%fice(ix) > Model%min_lakeice .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist - else ! obtain landfrac from slmsk - if (Sfcprop(nb)%slmsk(ix) > 1.9_r8) then - Sfcprop(nb)%landfrac(ix) = zero +! if (Sfcprop(nb)%lakefrac(ix) > zero) then +!! Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) +! Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) +! if (Sfcprop(nb)%lakefrac(ix) == zero) Sfcprop(nb)%fice(ix) = zero +! endif +! Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) +! if (Sfcprop(nb)%fice(ix) > Model%min_lakeice .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist +! else ! obtain landfrac from slmsk +! if (Sfcprop(nb)%slmsk(ix) > 1.9_r8) then +! Sfcprop(nb)%landfrac(ix) = zero +! else +! Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) +! endif +! endif + +!------------------------------------------------- + + if (Model%frac_grid) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif + endif + else + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif + endif + endif else - Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + endif + endif + endif + endif + else ! not a fractional grid + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = one + else + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2 + endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + Sfcprop(nb)%slmsk(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + endif endif endif - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell -! if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then -! Sfcprop(nb)%fice(ix) = zero -! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 -! endif - else - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) -! if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then -! Sfcprop(nb)%fice(ix) = zero -! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0 -! endif - endif ! !--- NSSTM variables if (Model%nstf_name(1) > 0) then @@ -1186,7 +1263,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif #ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4 .or. (.not.warm_start)) then !--- 3D variables do lsoil = 1,Model%lsoil Sfcprop(nb)%stc(ix,lsoil) = sfc_var3(i,j,lsoil,1) !--- stc @@ -1203,7 +1280,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) do lsoil = 1, 4 Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(i,j,lsoil,7) - enddo + enddo do lsoil = -2, 4 Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(i,j,lsoil,8) @@ -1234,7 +1311,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%snicexy(ix,lsoil) = sfc_var3sn(i,j,lsoil,4) Sfcprop(nb)%snliqxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,5) Sfcprop(nb)%tsnoxy(ix,lsoil) = sfc_var3sn(i,j,lsoil,6) - enddo + enddo do lsoil = 1, 4 Sfcprop(nb)%smoiseq(ix,lsoil) = sfc_var3eq(i,j,lsoil,7) @@ -1242,7 +1319,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) do lsoil = -2, 4 Sfcprop(nb)%zsnsoxy(ix,lsoil) = sfc_var3zn(i,j,lsoil,8) - enddo + enddo endif #endif @@ -1278,7 +1355,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !--- if sncovr does not exist in the restart, need to create it if (sfc_var2(i,j,32) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr') + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr') !--- compute sncovr from existing variables !--- code taken directly from read_fix.f !$omp parallel do default(shared) private(nb, ix, vegtyp, rsnow) @@ -1332,7 +1409,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlw') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -1347,7 +1424,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) !$omp parallel do default(shared) private(nb, ix, tem, tem1) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) -! Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) + if (Model%phour < 1.e-7) Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) tem1 = one - Sfcprop(nb)%landfrac(ix) tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & @@ -1360,7 +1437,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) enddo enddo else - if( Model%phour < 1.e-7) then + if (Model%phour < 1.e-7) then !$omp parallel do default(shared) private(nb, ix, tem) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -1370,7 +1447,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) ! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix) ! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix) if (Sfcprop(nb)%slmsk(ix) == 1) then - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) else tem = one - Sfcprop(nb)%fice(ix) @@ -1526,11 +1603,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) masssai = 1000.0 / 3.0 Sfcprop(nb)%stmassxy(ix) = Sfcprop(nb)%xsaixy(ix)* masssai - Sfcprop(nb)%rtmassxy(ix) = 500.0 + Sfcprop(nb)%rtmassxy(ix) = 500.0 - Sfcprop(nb)%woodxy (ix) = 500.0 - Sfcprop(nb)%stblcpxy(ix) = 1000.0 - Sfcprop(nb)%fastcpxy(ix) = 1000.0 + Sfcprop(nb)%woodxy (ix) = 500.0 + Sfcprop(nb)%stblcpxy(ix) = 1000.0 + Sfcprop(nb)%fastcpxy(ix) = 1000.0 endif ! non urban ... @@ -1574,18 +1651,18 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) dzsno(-2) = 0.05 dzsno(-1) = 0.5*(snd-0.05) dzsno(0) = 0.5*(snd-0.05) - elseif (snd > 0.45) then + elseif (snd > 0.45) then Sfcprop(nb)%snowxy(ix) = -3.0 dzsno(-2) = 0.05 dzsno(-1) = 0.20 dzsno(0) = snd - 0.05 - 0.20 else - call mpp_error(FATAL, 'problem with the logic assigning snow layers.') + call mpp_error(FATAL, 'problem with the logic assigning snow layers.') endif ! Now we have the snowxy field ! snice + snliq + tsno allocation and compute them from what we have - + ! Sfcprop(nb)%tsnoxy(ix,-2:0) = 0.0 Sfcprop(nb)%snicexy(ix,-2:0) = 0.0 @@ -1671,7 +1748,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%smcwtdxy(ix) = smcmax Sfcprop(nb)%deeprechxy(ix) = 0.0 Sfcprop(nb)%rechxy(ix) = 0.0 - + endif !end if slmsk>0.01 (land only) enddo ! ix @@ -1682,16 +1759,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) end subroutine sfc_prop_restart_read -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! sfc_prop_restart_write -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! routine to write out GFS surface restarts via the GFDL FMS restart ! subsystem. -! takes an optional argument to append timestamps for intermediate +! takes an optional argument to append timestamps for intermediate ! restarts. ! ! calls: register_restart_field, save_restart -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timestamp) !--- interface variable definitions type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) @@ -1777,7 +1854,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) allocate(sfc_name3(0:nvar3+nvar3mp)) allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) elseif (Model%lsm == Model%lsm_ruc) then allocate(sfc_var3(nx,ny,Model%lsoil_lsm,nvar3)) @@ -1908,7 +1985,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' endif - + !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) @@ -1928,7 +2005,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta enddo endif #ifdef CCPP - if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 + if (Model%lsm == Model%lsm_ruc) then ! nvar2mp =0 do num = nvar2m+nvar2o+1, nvar2m+nvar2o+nvar2r var2_p => sfc_var2(:,:,num) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -1946,7 +2023,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nullify(var2_p) #ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' sfc_name3(2) = 'smc' @@ -2012,7 +2089,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif ! lsm = lsm_noahmp endif - + !$omp parallel do default(shared) private(i, j, nb, ix, lsoil) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -2142,7 +2219,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta #ifdef CCPP - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then !--- 3D variables do lsoil = 1,Model%lsoil sfc_var3(i,j,lsoil,1) = Sfcprop(nb)%stc(ix,lsoil) !--- stc @@ -2211,19 +2288,19 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta end subroutine sfc_prop_restart_write -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! phys_restart_read -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! creates and populates a data type which is then used to "register" ! restart variables with the GFDL FMS restart subsystem. ! calls a GFDL FMS routine to restore the data from a restart file. ! calculates sncovr if it is not present in the restart file. ! ! calls: register_restart_field, restart_state, free_restart -! +! ! opens: phys_data.tile?.nc -! -!---------------------------------------------------------------------- +! +!---------------------------------------------------------------------- subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) !--- interface variable definitions type(IPD_restart_type), intent(in) :: IPD_Restart @@ -2251,14 +2328,14 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) nvar3d = IPD_Restart%num3d fdiag = IPD_Restart%fdiag ldiag = IPD_Restart%ldiag - + !--- register the restart fields if (.not. allocated(phy_var2)) then allocate (phy_var2(nx,ny,nvar2d)) allocate (phy_var3(nx,ny,npz,nvar3d)) phy_var2 = zero phy_var3 = zero - + do num = 1,nvar2d var2_p => phy_var2(:,:,num) id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_Restart%name2d(num)), & @@ -2288,7 +2365,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) !$omp parallel do default(shared) private(i, j, nb, ix) do num = 1,nvar2d do nb = 1,Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 IPD_Restart%data(nb,num)%var2p(ix) = phy_var2(i,j,num) @@ -2312,7 +2389,7 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) !$omp parallel do default(shared) private(i, j, k, nb, ix) do nb = 1,Atm_block%nblks do k=1,npz - do ix = 1, Atm_block%blksz(nb) + do ix = 1, Atm_block%blksz(nb) i = Atm_block%index(nb)%ii(ix) - isc + 1 j = Atm_block%index(nb)%jj(ix) - jsc + 1 IPD_Restart%data(nb,num)%var3p(ix,k) = phy_var3(i,j,k,num) @@ -2324,16 +2401,16 @@ subroutine phys_restart_read (IPD_Restart, Atm_block, Model, fv_domain) end subroutine phys_restart_read -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! phys_restart_write -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- ! routine to write out GFS surface restarts via the GFDL FMS restart ! subsystem. ! takes an optional argument to append timestamps for intermediate ! restarts. ! ! calls: register_restart_field, save_restart -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timestamp) !--- interface variable definitions type(IPD_restart_type), intent(in) :: IPD_Restart @@ -2366,7 +2443,7 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta allocate (phy_var3(nx,ny,npz,nvar3d)) phy_var2 = zero phy_var3 = zero - + do num = 1,nvar2d var2_p => phy_var2(:,:,num) id_restart = register_restart_field (Phy_restart, fn_phy, trim(IPD_Restart%name2d(num)), & @@ -2410,9 +2487,9 @@ subroutine phys_restart_write (IPD_Restart, Atm_block, Model, fv_domain, timesta end subroutine phys_restart_write -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- !--- gfdl_diag_register --- -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! creates and populates a data type which is then used to "register" ! GFS physics diagnostic variables with the GFDL FMS diagnostic manager. ! includes short & long names, units, conversion factors, etc. @@ -2421,7 +2498,7 @@ end subroutine phys_restart_write ! the diag_table to determine what variables are to be output. ! ! calls: register_diag_field -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) use physcons, only: con_g !--- subroutine interface variable definitions @@ -2461,7 +2538,7 @@ subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) enddo if (tot_diag_idx == DIAG_SIZE) then - call mpp_error(fatal, 'FV3GFS_io::fv3gfs_diag_register - need to increase parameter DIAG_SIZE') + call mpp_error(fatal, 'FV3GFS_io::fv3gfs_diag_register - need to increase parameter DIAG_SIZE') endif allocate(nstt(tot_diag_idx), nstt_vctbl(tot_diag_idx)) @@ -2526,17 +2603,17 @@ subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) ' nrgst_vctbl=',nrgst_vctbl, 'isco=',isco,ieco,'jsco=',jsco,jeco,' num_axes_phys=', num_axes_phys end subroutine fv3gfs_diag_register -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- !--- gfs_diag_output --- -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- ! routine to transfer the diagnostic data to the gfdl fms diagnostic ! manager for eventual output to the history files. ! ! calls: send_data -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & dt, time_int, time_intfull, time_radsw, time_radlw) !--- subroutine interface variable definitions From 9d4fe97abdd4e5bbc0c7bdd5cc8ecd28d7729f3a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 26 Nov 2020 17:32:25 +0000 Subject: [PATCH 104/217] updating some SDFs --- ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml | 4 ++-- ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml | 4 ++-- ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml | 3 ++- ccpp/suites/suite_FV3_GFS_v17_ras.xml | 4 ++-- ccpp/suites/suite_FV3_GFS_v17_sas.xml | 3 ++- 5 files changed, 10 insertions(+), 8 deletions(-) diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml index 4733f2c82..d73a3e552 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml @@ -6,7 +6,7 @@ fv_sat_adj - / + GFS_time_vary_pre @@ -72,7 +72,6 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - GFS_suite_interstitial_5 rascnv GFS_DCNV_generic_post GFS_SCNV_generic_pre @@ -89,6 +88,7 @@ GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml index 92a4e1e5d..e9bb7477a 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml @@ -6,7 +6,7 @@ fv_sat_adj - / + GFS_time_vary_pre @@ -72,7 +72,6 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - GFS_suite_interstitial_5 rascnv GFS_DCNV_generic_post GFS_suite_interstitial_4 @@ -86,6 +85,7 @@ GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml index 32d64d35e..21f71cb74 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml @@ -6,7 +6,7 @@ fv_sat_adj - / + GFS_time_vary_pre @@ -88,6 +88,7 @@ GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras.xml b/ccpp/suites/suite_FV3_GFS_v17_ras.xml index 5f3aaf00b..a729a0c83 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_ras.xml @@ -6,7 +6,7 @@ fv_sat_adj - / + GFS_time_vary_pre @@ -71,7 +71,6 @@ get_phi_fv3 GFS_suite_interstitial_3 GFS_DCNV_generic_pre - GFS_suite_interstitial_5 rascnv GFS_DCNV_generic_post GFS_SCNV_generic_pre @@ -88,6 +87,7 @@ GFS_stochastics + phys_tend diff --git a/ccpp/suites/suite_FV3_GFS_v17_sas.xml b/ccpp/suites/suite_FV3_GFS_v17_sas.xml index 3af18fac4..01acf5744 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_sas.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_sas.xml @@ -6,7 +6,7 @@ fv_sat_adj - / + GFS_time_vary_pre @@ -87,6 +87,7 @@ GFS_stochastics + phys_tend From 5515b60ca35debc46a508413f50bc82591dae5da Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 29 Nov 2020 01:54:46 +0000 Subject: [PATCH 105/217] after suncing submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 3975a972c..f5c496bbb 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3975a972c0c5ff7415a3d7dd71db35d7be9e2928 +Subproject commit f5c496bbb2c532a81d540d320f42cbb8dca3a635 From c05373523c20680e5a7687bb74199f519108b3c3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 2 Dec 2020 18:58:47 +0000 Subject: [PATCH 106/217] updating the IPD side to change iovr_sw and iovr_lw to just iovr - this version does reproduce 48 hour restart runs in the coupled mode --- gfsphysics/GFS_layer/GFS_radiation_driver.F90 | 7 ++--- gfsphysics/physics/physparam.f | 18 ++++++------ gfsphysics/physics/rad_initialize.f | 15 +++++----- gfsphysics/physics/radiation_clouds.f | 8 +++--- gfsphysics/physics/radlw_main.f | 26 ++++++++--------- gfsphysics/physics/radsw_main.f | 28 +++++++++---------- 6 files changed, 51 insertions(+), 51 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 index da5078f7b..4f056a457 100644 --- a/gfsphysics/GFS_layer/GFS_radiation_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_radiation_driver.F90 @@ -220,7 +220,7 @@ ! icsdsw/icsdlw (if isubcsw/isubclw =2, it will be ! ! the user provided permutation seeds) to the sw/lw ! ! radiation calculation programs. also moved cloud ! -! overlapping control flags iovrsw/iovrlw from main ! +! overlapping control flags iovr from main ! ! radiation routines to the initialization routines.! ! 04-02-09 yu-tai hou - modified surface control flag iems to ! ! have additional function of if the surface-air ! @@ -508,8 +508,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! =8 Thompson microphysics scheme ! ! =6 WSM6 microphysics scheme ! ! =10 MG microphysics scheme ! -! iovrsw : control flag for cloud overlap in sw radiation ! -! iovrlw : control flag for cloud overlap in lw radiation ! +! iovr : control flag for cloud overlap in sw/lw radiation ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! ! isubcsw : sub-column cloud approx control flag in sw radiation ! @@ -568,7 +567,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg - print *,' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw, & + print *,' IVFLIP=',ivflip,' IOVR=',iovr, & & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw ! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& ! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw diff --git a/gfsphysics/physics/physparam.f b/gfsphysics/physics/physparam.f index f78191278..3af516be6 100644 --- a/gfsphysics/physics/physparam.f +++ b/gfsphysics/physics/physparam.f @@ -239,15 +239,15 @@ module physparam ! !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method -!!\n Opr GFS/CFS=1; see IOVR_SW in run scripts - integer, save :: iovrsw = 1 -!> cloud overlapping control flag for LW -!!\n =0:use random cloud overlapping method -!!\n =1:use maximum-random cloud overlapping method -!!\n =2:use maximum cloud overlapping method -!!\n =3:use decorrelation length overlapping method -!!\n Opr GFS/CFS=1; see IOVR_LW in run scripts - integer, save :: iovrlw = 1 +!!\n =4:use exponential overlapping method +!!\n =5:use exponential-random overlapping method +!!\n Opr GFS/CFS=1; see IOVR in run scripts + integer, save :: iovr = 1 +!!\n Decorrelation length type for iovr = 4 or 5 +!!\n =0:use constant decorrelation length defined by decorr_con (in +!module physcons) +!!\n =1:use day-of-year and latitude-varying decorrelation length + integer, save :: idcor = 1 !> sub-column cloud approx flag in SW radiation !!\n =0:no McICA approximation in SW radiation diff --git a/gfsphysics/physics/rad_initialize.f b/gfsphysics/physics/rad_initialize.f index 46db2c23b..28288d5d0 100644 --- a/gfsphysics/physics/rad_initialize.f +++ b/gfsphysics/physics/rad_initialize.f @@ -3,7 +3,7 @@ subroutine rad_initialize & !................................... ! --- inputs: & ( si,levr,ictm,isol,ico2,iaer,ialb,iems,ntcw, num_p2d, & - & num_p3d,npdf3d,ntoz,iovr isubc_sw,isubc_lw, & + & num_p3d,npdf3d,ntoz,iovr, isubc_sw,isubc_lw, & ! & num_p3d,npdf3d,ntoz,iovr_sw,iovr_lw,isubc_sw,isubc_lw, & & icliq_sw,crick_proof,ccnorm, & & imp_physics,norad_precip,idate,iflip,me ) @@ -115,7 +115,8 @@ subroutine rad_initialize & use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& ! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & & iaermdl, icldflg, & - & iovr , lcrick , lcnorm , lnoprec, & + & lcrick , lcnorm , lnoprec, & +! & iovr, lcrick , lcnorm , lnoprec, & & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & & iswcliq, & & kind_phys @@ -126,7 +127,7 @@ subroutine rad_initialize & ! --- input: integer, intent(in) :: levr, ictm, isol, ico2, iaer, num_p2d, & - & ntcw, ialb, iems, num_p3d, npdf3d, ntoz, iovr , & + & ntcw, ialb, iems, num_p3d, npdf3d, ntoz, iovr, & & isubc_sw, isubc_lw, icliq_sw, iflip, me, idate(4) real (kind=kind_phys), intent(in) :: si(levr+1) @@ -167,8 +168,8 @@ subroutine rad_initialize & iswcliq = icliq_sw ! optical property for liquid clouds for sw - iovrsw = iovr ! cloud overlapping control flag for sw - iovrlw = iovr ! cloud overlapping control flag for lw +! iovrsw = iovr ! cloud overlapping control flag for sw +! iovrlw = iovr ! cloud overlapping control flag for lw lcrick = crick_proof ! control flag for eliminating CRICK lcnorm = ccnorm ! control flag for in-cld condensate @@ -193,8 +194,8 @@ subroutine rad_initialize & print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& & ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr=',iovr, & - & ' iovrsw=',iovrsw,' iovrlw=',iovrlw, & - ' isubc_sw=', isubc_sw, & +! & ' iovrsw=',iovrsw,' iovrlw=',iovrlw, & + & ' isubc_sw=', isubc_sw, & & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & & ' iflip=',iflip,' me=',me print *,' crick_proof=',crick_proof, & diff --git a/gfsphysics/physics/radiation_clouds.f b/gfsphysics/physics/radiation_clouds.f index 99d58b677..2a055e2d4 100644 --- a/gfsphysics/physics/radiation_clouds.f +++ b/gfsphysics/physics/radiation_clouds.f @@ -244,7 +244,7 @@ module module_radiation_clouds ! !........................................! ! - use physparam, only : icldflg, iovrsw, iovrlw, & + use physparam, only : icldflg, iovr, & & lcrick, lcnorm, lnoprec, & & ivflip, kind_phys, kind_io4 use physcons, only : con_fvirt, con_ttp, con_rocp, & @@ -297,7 +297,7 @@ module module_radiation_clouds ! !> upper limit of boundary layer clouds integer :: llyr = 2 !> maximum-random cloud overlapping method - integer :: iovr = 1 +! integer :: iovr = 1 public progcld1, progcld2, progcld3, progcld4, progclduni, & & cld_init, progcld5, progcld4o @@ -347,7 +347,7 @@ subroutine cld_init & ! =8: Thompson microphysics ! ! =6: WSM6 microphysics ! ! =10: MG microphysics ! -! iovrsw/iovrlw : sw/lw control flag for cloud overlapping scheme ! +! iovr : sw/lw control flag for cloud overlapping scheme ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! @@ -378,7 +378,7 @@ subroutine cld_init & ! ! --- set up module variables - iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output +! iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output if (me == 0) print *, VTAGCLD !print out version tag diff --git a/gfsphysics/physics/radlw_main.f b/gfsphysics/physics/radlw_main.f index dae7329bb..74b8fed15 100644 --- a/gfsphysics/physics/radlw_main.f +++ b/gfsphysics/physics/radlw_main.f @@ -283,7 +283,7 @@ module module_radlw_main ! !........................................! ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & isubclw, icldflg, iovrlw, ivflip, & + & isubclw, icldflg, iovr, ivflip, & & kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 @@ -557,7 +557,7 @@ subroutine lwrad & ! =0: no sub-col cld treatment, use grid-mean cld quantities ! ! =1: mcica sub-col, prescribed seeds to get random numbers ! ! =2: mcica sub-col, providing array icseed for random numbers! -! iovrlw - cloud overlapping control flag ! +! iovr - cloud overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (used for isubclw>0 only) ! @@ -762,7 +762,7 @@ subroutine lwrad & endif stemp = sfgtmp(iplon) ! surface ground temp - if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length + if (iovr == 3) delgth= de_lgth(iplon) ! clouds decorr-length !> -# Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top @@ -1155,7 +1155,7 @@ subroutine lwrad & if (isubclw <= 0) then - if (iovrlw <= 0) then + if (iovr <= 0) then call rtrn & ! --- inputs: @@ -1175,7 +1175,7 @@ subroutine lwrad & & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & & ) - endif ! end if_iovrlw_block + endif ! end if_iovr_block else @@ -1319,7 +1319,7 @@ subroutine rlwinit & ! icldflg - cloud scheme control flag ! ! =0: diagnostic scheme gives cloud tau, omiga, and g. ! ! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrlw - clouds vertical overlapping control flag ! +! iovr - clouds vertical overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (isubcol>0 only) ! @@ -1367,19 +1367,19 @@ subroutine rlwinit & ! !===> ... begin here ! - if ( iovrlw<0 .or. iovrlw>3 ) then + if ( iovr<0 .or. iovr>3 ) then print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRLW=',iovrlw,' in RLWINIT !!' + & ' IOVR=',iovr,' in RLWINIT !!' stop - elseif ( iovrlw>=2 .and. isubclw==0 ) then + elseif ( iovr>=2 .and. isubclw==0 ) then if (me == 0) then - print *,' *** IOVRLW=',iovrlw,' is not available for', & + print *,' *** IOVR=',iovr,' is not available for', & & ' ISUBCLW=0 setting!!' print *,' The program uses maximum/random overlap', & & ' instead.' endif - iovrlw = 1 + iovr = 1 endif if (me == 0) then @@ -1842,7 +1842,7 @@ subroutine mcica_subcol & ! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! ! ! ! other control flags from module variables: ! -! iovrlw : control flag for cloud overlapping method ! +! iovr : control flag for cloud overlapping method ! ! =0:random; =1:maximum/random: =2:maximum; =3:decorr ! ! ! ! ===================== end of definitions ==================== ! @@ -1880,7 +1880,7 @@ subroutine mcica_subcol & ! --- ... sub-column set up according to overlapping assumption - select case ( iovrlw ) + select case ( iovr ) case( 0 ) ! random overlap, pick a random value at every level diff --git a/gfsphysics/physics/radsw_main.f b/gfsphysics/physics/radsw_main.f index cf2640d78..16680ee98 100644 --- a/gfsphysics/physics/radsw_main.f +++ b/gfsphysics/physics/radsw_main.f @@ -413,7 +413,7 @@ module module_radsw_main ! !........................................! ! use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & - & isubcsw, icldflg, iovrsw, ivflip, & + & isubcsw, icldflg, iovr, ivflip, & & iswmode, kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 @@ -711,7 +711,7 @@ subroutine swrad & ! =0: no sub-col cld treatment, use grid-mean cld quantities ! ! =1: mcica sub-col, prescribed seeds to get random numbers ! ! =2: mcica sub-col, providing array icseed for random numbers! -! iovrsw - cloud overlapping control flag ! +! iovr - cloud overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -913,7 +913,7 @@ subroutine swrad & cosz1 = cosz(j1) sntz1 = f_one / cosz(j1) ssolar = s0fac * cosz(j1) - if (iovrsw == 3) delgth = de_lgth(j1) ! clouds decorr-length + if (iovr == 3) delgth = de_lgth(j1) ! clouds decorr-length !> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. albbm(1) = sfcalb(j1,1) @@ -1114,11 +1114,11 @@ subroutine swrad & zcf0 = f_one zcf1 = f_one - if (iovrsw == 0) then ! random overlapping + if (iovr == 0) then ! random overlapping do k = 1, nlay zcf0 = zcf0 * (f_one - cfrac(k)) enddo - else if (iovrsw == 1) then ! max/ran overlapping + else if (iovr == 1) then ! max/ran overlapping do k = 1, nlay if (cfrac(k) > ftiny) then ! cloudy layer zcf1 = min ( zcf1, f_one-cfrac(k) ) @@ -1128,7 +1128,7 @@ subroutine swrad & endif enddo zcf0 = zcf0 * zcf1 - else if (iovrsw >= 2) then + else if (iovr >= 2) then do k = 1, nlay zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator enddo @@ -1433,7 +1433,7 @@ subroutine rswinit & ! icldflg - cloud scheme control flag ! ! =0: diagnostic scheme gives cloud tau, omiga, and g. ! ! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrsw - clouds vertical overlapping control flag ! +! iovr - clouds vertical overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -1469,9 +1469,9 @@ subroutine rswinit & ! !===> ... begin here ! - if ( iovrsw<0 .or. iovrsw>3 ) then + if ( iovr<0 .or. iovr>3 ) then print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRSW=',iovrsw,' in RSWINIT !!' + & ' IOVR=',iovr,' in RSWINIT !!' stop endif @@ -1518,15 +1518,15 @@ subroutine rswinit & stop endif - if ( isubcsw==0 .and. iovrsw>2 ) then + if ( isubcsw==0 .and. iovr>2 ) then if (me == 0) then - print *,' *** IOVRSW=',iovrsw,' is not available for', & + print *,' *** IOVR=',iovr,' is not available for', & & ' ISUBCSW=0 setting!!' print *,' The program will use maximum/random overlap', & & ' instead.' endif - iovrsw = 1 + iovr = 1 endif ! --- ... setup constant factors for heating rate @@ -1997,7 +1997,7 @@ subroutine mcica_subcol & ! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! ! ! ! other control flags from module variables: ! -! iovrsw : control flag for cloud overlapping method ! +! iovr : control flag for cloud overlapping method ! ! =0: random ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -2038,7 +2038,7 @@ subroutine mcica_subcol & ! --- ... sub-column set up according to overlapping assumption - select case ( iovrsw ) + select case ( iovr ) case( 0 ) ! random overlap, pick a random value at every level From 94072066a5da9cafce6705cbad2c9076253148ca Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 2 Dec 2020 20:04:22 +0000 Subject: [PATCH 107/217] adding my version of post_gfs --- ccpp/physics | 2 +- io/post_gfs.F90 | 922 ++++++++-------- io/post_gfs.F90_mine | 2511 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 2954 insertions(+), 481 deletions(-) create mode 100644 io/post_gfs.F90_mine diff --git a/ccpp/physics b/ccpp/physics index f5c496bbb..0817a048b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f5c496bbb2c532a81d540d320f42cbb8dca3a635 +Subproject commit 0817a048beb0ae2c1dc7699933a009427613849c diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 248ce6d06..76dd0251c 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,20 +112,19 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -138,16 +137,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -240,62 +239,66 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -329,8 +332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng + pint, exch_h, ref_10cm use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -358,11 +360,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -387,12 +389,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -471,7 +473,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -482,7 +484,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -494,10 +496,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -505,7 +507,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -513,16 +514,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -597,7 +604,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -713,19 +720,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -737,17 +744,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -759,8 +768,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -768,27 +778,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -796,14 +808,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -812,58 +824,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j) = arrayr42d(i,j) +! pint(i,j)=arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -872,18 +884,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -894,114 +906,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1010,8 +1022,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1020,8 +1032,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1033,8 +1045,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1046,8 +1058,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1059,8 +1071,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1072,8 +1084,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1085,8 +1097,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1098,8 +1110,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1111,8 +1123,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1125,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1137,8 +1149,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1152,8 +1164,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1167,8 +1179,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1183,8 +1195,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1194,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1205,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1216,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1227,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1238,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1249,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1260,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1271,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1283,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1295,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1307,8 +1319,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1320,7 +1332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1329,8 +1341,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1339,8 +1351,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1350,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1360,8 +1372,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1370,8 +1382,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1380,8 +1392,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1390,8 +1402,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1400,8 +1412,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1410,8 +1422,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1421,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1431,8 +1443,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1441,8 +1453,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1452,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1463,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1475,8 +1487,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1486,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1497,30 +1509,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1529,8 +1541,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1539,8 +1551,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1549,8 +1561,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1559,30 +1571,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1592,8 +1604,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1603,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1617,8 +1629,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1631,8 +1643,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1642,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1653,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1663,8 +1675,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1673,8 +1685,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1683,8 +1695,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1693,8 +1705,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1703,8 +1715,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1713,8 +1725,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1723,8 +1735,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1733,8 +1745,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1743,8 +1755,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1754,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1764,8 +1776,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1775,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1785,8 +1797,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1795,8 +1807,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1805,8 +1817,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1816,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1826,8 +1838,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1837,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1847,8 +1859,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1857,8 +1869,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1867,8 +1879,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1877,8 +1889,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1887,8 +1899,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1897,8 +1909,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1907,8 +1919,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1917,8 +1929,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1927,8 +1939,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1937,8 +1949,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1947,8 +1959,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1957,8 +1969,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1968,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1979,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -1990,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2001,19 +2013,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2023,8 +2035,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2034,17 +2046,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2054,8 +2068,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2065,7 +2079,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2075,237 +2089,172 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP -! ------------------ - if (imp_physics == 10 .or. imp_physics == 11) then +! for GFDL MP + if (imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif ! for MG3 MP +!gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2313,12 +2262,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2326,7 +2275,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2352,33 +2302,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2386,23 +2349,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2428,13 +2390,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 - if( imp_physics == 10 .or. imp_physics == 11) then +! compute cwm for gfdlmp + if( imp_physics == 11 ) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2444,8 +2406,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2456,13 +2418,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend diff --git a/io/post_gfs.F90_mine b/io/post_gfs.F90_mine new file mode 100644 index 000000000..248ce6d06 --- /dev/null +++ b/io/post_gfs.F90_mine @@ -0,0 +1,2511 @@ +!----------------------------------------------------------------------- +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +!----------------------------------------------------------------------- +! +module post_gfs + + use module_fv3_io_def, only : wrttasks_per_group,filename_base + use write_internal_state, only : wrt_internal_state + + implicit none + + include 'mpif.h' + + integer mype, nbdl + logical setvar_atmfile, setvar_sfcfile, read_postcntrl + public post_run_gfs, post_getattr_gfs + + contains + + subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & + mynfhr,mynfmin,mynfsec) +! +! revision history: +! Jul 2019 J. Wang create interface to run inline post for FV3 +! +!----------------------------------------------------------------------- +!*** run post on write grid comp +!----------------------------------------------------------------------- +! + use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & + npset,grib,gocart_on,icount_calmict, jsta, & + jend,im, nsoil, filenameflat + use gridspec_mod, only : maptype, gridtype + use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl + use xml_perl_data,only : paramset +! +!----------------------------------------------------------------------- +! + implicit none +! +!----------------------------------------------------------------------- +! + type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: mypei + integer,intent(in) :: mpicomp + integer,intent(in) :: lead_write + integer,intent(in) :: mynfhr + integer,intent(in) :: mynfmin + integer,intent(in) :: mynfsec +! +!----------------------------------------------------------------------- +!*** LOCAL VARIABLES +!----------------------------------------------------------------------- +! + integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil + integer,allocatable :: jstagrp(:),jendgrp(:) + integer,save :: kpo,kth,kpv + logical,save :: log_postalct=.false. + real,dimension(komax),save :: po, th, pv + logical :: Log_runpost + character(255) :: post_fname*255 + + integer,save :: iostatusD3D=-1 +! + real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 +! +! print *,'in post_run start' +!----------------------------------------------------------------------- +!*** set up dimensions +!----------------------------------------------------------------------- +! + btim0 = MPI_Wtime() + + modelname = "GFS" + grib = "grib2" + gridtype = "A" + nsoil = 4 + mype = mypei + nwtpg = wrt_int_state%petcount + jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection + jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection + maptype = wrt_int_state%post_maptype + nbdl = wrt_int_state%FBCount + + if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & + 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct + +! +!----------------------------------------------------------------------- +!*** set up fields to run post +!----------------------------------------------------------------------- +! + if (.not.log_postalct) then +! + allocate(jstagrp(nwtpg),jendgrp(nwtpg)) +! + do n=0,nwtpg-1 + jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) + jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) + enddo + if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp + +!----------------------------------------------------------------------- +!*** read namelist for pv,th,po +!----------------------------------------------------------------------- +! + call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_nlunit, & + wrt_int_state%post_namelist) +! +!----------------------------------------------------------------------- +!*** allocate post variables +!----------------------------------------------------------------------- +! +! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! 'jstagrp=',jstagrp,'jendgrp=',jendgrp + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) +! +!----------------------------------------------------------------------- +!*** read namelist for pv,th,po +!----------------------------------------------------------------------- +! + log_postalct = .true. + first_grbtbl = .true. + read_postcntrl = .true. +! + ENDIF +! +!----------------------------------------------------------------------- +!*** fill post variables with values from forecast results +!----------------------------------------------------------------------- +! + ifhr = mynfhr + ifmin = mynfmin + if (ifhr == 0 ) ifmin = 0 + if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr + setvar_atmfile = .false. + setvar_sfcfile = .false. + call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & + setvar_sfcfile) + +! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & +! 'setvar_sfcfile=',setvar_sfcfile +! + if (setvar_atmfile.and.setvar_sfcfile) then +! 20190807 need to call microinit only for Ferrier microphysics +! call MICROINIT +! + if(grib=="grib2" .and. read_postcntrl) then + if (ifhr == 0) then + filenameflat = 'postxconfig-NT_FH00.txt' + call read_xml() + if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat) + else if(ifhr > 0) then + filenameflat = 'postxconfig-NT.txt' + if(size(paramset)>0) then + do i=1,size(paramset) + if (size(paramset(i)%param)>0) then + deallocate(paramset(i)%param) + nullify(paramset(i)%param) + endif + enddo + deallocate(paramset) + nullify(paramset) + endif + num_pset = 0 + call read_xml() + if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr + read_postcntrl = .false. + endif + endif +! + IEOF = 0 + npset = 0 + icount_calmict = 0 + do while( IEOF == 0) +! + if(grib == "grib2") then + npset = npset + 1 + call set_outflds(kth,th,kpv,pv) + if(allocated(datapd))deallocate(datapd) + allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) + do k=1,nrecout+100 + do j=1,jend+1-jsta + do i=1,im + datapd(i,j,k) = 0. + enddo + enddo + enddo + call get_postfilename(post_fname) + if (mype==0) write(0,*)'post_fname=',trim(post_fname) +! + if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) +! + call mpi_barrier(mpicomp,ierr) + call gribit2(post_fname) + if(allocated(datapd))deallocate(datapd) + if(allocated(fld_info))deallocate(fld_info) + if(npset >= num_pset) exit + + endif +! + enddo +! + endif + + end subroutine post_run_gfs +! +!----------------------------------------------------------------------- +! + subroutine post_getattr_gfs(wrt_int_state, fldbundle) +! + use esmf + use ctlblk_mod, only: im, jm, mpi_comm_comp + use masks, only: gdlat, gdlon, dx, dy + use gridspec_mod, only: latstart, latlast, lonstart, & + lonlast, cenlon, cenlat +! + implicit none +! + type(wrt_internal_state),intent(inout) :: wrt_int_state + type(ESMF_FieldBundle), intent(in) :: fldbundle +! +! local variable + integer i,j,k,n,kz, attcount + integer ni,naryi,nr4,nr8,rc + integer aklen,varival + real(4) varr4val + real(8) varr8val + character(80) attName, hydrostatics, fldname + type(ESMF_TypeKind_Flag) :: typekind + real(4), dimension(:), allocatable :: ak4,bk4 + real(8), dimension(:), allocatable :: ak8,bk8 +! +! look at the field bundle attributes + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return +! + aklen=0. + do i=1, attCount + + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + + if (typekind==ESMF_TYPEKIND_I4 ) then + if(n == 1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + endif + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (trim(attName) == 'dtp') then + wrt_int_state%dtp=varr4val + endif + else if(n > 1) then + if(trim(attName) =="ak") then + if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) + allocate(wrt_int_state%ak(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + wrt_int_state%lm = n-1 + else if(trim(attName) == "bk") then + if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) + allocate(wrt_int_state%bk(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + endif + endif + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr8val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (trim(attName) == 'dtp') then + wrt_int_state%dtp=varr8val + endif + else if(n > 1) then + if(trim(attName) == "ak") then + if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) + allocate(wrt_int_state%ak(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + wrt_int_state%lm = n-1 + else if(trim(attName) =="bk") then + if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) + allocate(wrt_int_state%bk(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + endif + wrt_int_state%lm = size(wrt_int_state%ak) - 1 + endif + endif +! + enddo +! print *,'in post_getattr, dtp=',wrt_int_state%dtp +! + end subroutine post_getattr_gfs +!----------------------------------------------------------------------- +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +!----------------------------------------------------------------------- +! + subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & + setvar_sfcfile) +! +! revision history: +! Jul 2019 J. Wang Initial code +! +!----------------------------------------------------------------------- +!*** set up post fields from nmint_state +!----------------------------------------------------------------------- +! + use esmf + use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & + qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & + q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng + use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& + qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& + cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& + avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, & + cfrach, cfracl, cfracm, avgcfrach, qshltr, & + avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& + vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & + bgroff, rlwin, & + rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & + rswinc, rswout, aswin, auvbin, auvbinc, aswout, & + aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & + sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & + smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & + acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & + htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & + pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& + maxtshltr, mintshltr, maxrhshltr, minrhshltr, & + dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & + htops, hbots, aswintoa, maxqshltr, minqshltr, & + acond, sr, u10h, v10h, avgedir, avgecan, & + avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& + avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & + alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& + avgpotevp, snoavg, ti, si, cuppt + use soil, only: sldpth, sh2o, smc, stc + use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice + use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst + use params_mod, only: erad, dtr, capa, p1000 + use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat + use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & + qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 + use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & + eps => con_eps, epsm1 => con_epsm1 + use rqstfld_mod +! +! use write_internal_state, only: wrt_internal_state +! +!----------------------------------------------------------------------- +! + implicit none +! + include 'mpif.h' +! +!----------------------------------------------------------------------- +! + type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: mpicomp + logical,intent(inout) :: setvar_atmfile,setvar_sfcfile +! +!----------------------------------------------------------------------- +! + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer ista,iend,fieldDimCount,gridDimCount,ncount_field + integer jdate(8) + logical foundland, foundice, found + real(4) rinc(5) + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real, dimension(:),allocatable :: ak5, bk5 + real(4),dimension(:,:),pointer :: arrayr42d + real(8),dimension(:,:),pointer :: arrayr82d + real(4),dimension(:,:,:),pointer :: arrayr43d + real(8),dimension(:,:,:),pointer :: arrayr83d + real,dimension(:), allocatable :: slat,qstl + real,external::FPVSNEW + real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & + cw2d, cfr2d + character(len=80) :: fieldname, wrtFBName + type(ESMF_Grid) :: wrtGrid + type(ESMF_Field) :: theField + type(ESMF_Field), allocatable :: fcstField(:) + type(ESMF_TypeKind_Flag) :: typekind +! +!----------------------------------------------------------------------- +!*** INTEGER SCALAR/1D HISTORY VARIABLES +!----------------------------------------------------------------------- +! + imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme + dtp = wrt_int_state%dtp + iSF_SURFACE_PHYSICS = 2 + spval = 9.99e20 + +! +! nems gfs has zhour defined + tprec = float(wrt_int_state%fhzero) + tclod = tprec + trdlw = tprec + trdsw = tprec + tsrfc = tprec + tmaxmin = tprec + td3d = tprec + if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & + 'dtp=',dtp,'tmaxmin=',tmaxmin + +! write(6,*) 'maptype and gridtype is ', maptype,gridtype +! +!$omp parallel do default(shared),private(i,j) + do j=jsta,jend + do i=1,im + gdlat(i,j) = wrt_int_state%latPtr(i,j) + gdlon(i,j) = wrt_int_state%lonPtr(i,j) + enddo + enddo +! + lonstart = nint(wrt_int_state%lonstart*gdsdegr) + lonlast = nint(wrt_int_state%lonlast*gdsdegr) + latstart = nint(wrt_int_state%latstart*gdsdegr) + latlast = nint(wrt_int_state%latlast*gdsdegr) +! print*,'latstart,latlast B bcast= ',latstart,latlast +! print*,'lonstart,lonlast B bcast= ',lonstart,lonlast + +!$omp parallel do default(none),private(i,j,ip1), & +!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) + do j = jsta, jend_m + do i = 1, im + ip1 = i + 1 + if (ip1 > im) ip1 = ip1 - im + dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr + dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH + end do + end do +! + if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) + do i=1,lm+1 + ak5(i) = wrt_int_state%ak(i) + bk5(i) = wrt_int_state%bk(i) + enddo + +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) + do j=jsta,jend + do i=1,im + f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) + end do + end do +! +! GFS does not output PD + pt = ak5(1) + +! GFS may not have model derived radar ref. +! TKE +! cloud amount +!$omp parallel do default(none),private(i,j,l), & +!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) + do l=1,lm + do j=jsta,jend + do i=1,im + ref_10cm(i,j,l) = SPVAL + q2(i,j,l) = SPVAL + cfr(i,j,l) = SPVAL + enddo + enddo + enddo + +! GFS does not have surface specific humidity +! inst sensible heat flux +! inst latent heat flux +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) + do j=jsta,jend + do i=1,im + qs(i,j) = SPVAL + twbs(i,j) = SPVAL + qwbs(i,j) = SPVAL + ths(i,j) = SPVAL + enddo + enddo + +! GFS set up DT to compute accumulated fields, set it to one + dtq2 = wrt_int_state%dtp + nphs = 2. + dt = dtq2/nphs + dtq2001 = dtq2*0.001 +! +! GFS does not have convective cloud efficiency +! similated precip +! 10 m theta +! 10 m humidity +! snow free albedo +!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) + do j=jsta,jend + do i=1,im + cldefi(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL + albase(i,j) = SPVAL + + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? + enddo + enddo + +! GFS probably does not use zenith angle, czen, czmean +! inst surface outgoing longwave, radot +! inst cloud fraction for high, middle, and low cloud, +! cfrach +! inst ground heat flux, grnflx +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & +!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) + do j=jsta,jend + do i=1,im + czen(i,j) = SPVAL + czmean(i,j) = SPVAL + radot(i,j) = SPVAL + cfrach(i,j) = SPVAL + cfracl(i,j) = SPVAL + cfracm(i,j) = SPVAL + grnflx(i,j) = SPVAL + enddo + enddo +! +! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam + sldpth(1) = 0.10 + sldpth(2) = 0.3 + sldpth(3) = 0.6 + sldpth(4) = 1.0 + +! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n +! cfrcv to 1 +! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 +! UNDERGROUND RUNOFF, bgroff +! inst incoming sfc longwave, rlwin +! inst model top outgoing longwave,rlwtoa +! inst incoming sfc shortwave, rswin +! inst incoming clear sky sfc shortwave, rswinc +! inst outgoing sfc shortwave, rswout +! snow phase change heat flux, snopcx +! GFS does not use total momentum flux,sfcuvx +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & +!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) + do j=jsta,jend + do i=1,im + acfrcv(i,j) = spval + ncfrcv(i,j) = 1.0 + acfrst(i,j) = spval + ncfrst(i,j) = 1.0 + bgroff(i,j) = spval + rlwin(i,j) = spval + rlwtoa(i,j) = spval + rswin(i,j) = spval + rswinc(i,j) = spval + rswout(i,j) = spval + snopcx(i,j) = spval + sfcuvx(i,j) = spval + enddo + enddo + +! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 + ardlw = 1.0 +! GFS incoming sfc longwave has been averaged, set ARDLW to 1 + ardsw = 1.0 +! GFS surface flux has been averaged, set ASRFC to 1 + asrfc = 1.0 + +! GFS does not have temperature tendency due to long wave radiation +! temperature tendency due to short wave radiation +! temperature tendency due to latent heating from convection +! temperature tendency due to latent heating from grid scale + do l=1,lm +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & +!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) + do j=jsta_2l,jend_2u + do i=1,im + rlwtt(i,j,l) = spval + rswtt(i,j,l) = spval + tcucn(i,j,l) = spval + tcucns(i,j,l) = spval + train(i,j,l) = spval + enddo + enddo + enddo + +! set avrain to 1 + avrain = 1.0 + avcnvc = 1.0 + theat = 6.0 ! just in case GFS decides to output T tendency + +! GFS does not have temperature tendency due to latent heating from grid scale + train = spval + +! GFS does not have soil moisture availability, smstav +! accumulated surface evaporatio, sfcevp +! averaged accumulated snow, acsnow +! snow melt,acsnom +! humidity at roughness length, qz0 +! u at roughness length, uz0 +! v at roughness length, vz0 +! shelter rh max, maxrhshltr +! shelter rh min, minrhshltr +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) + do j=jsta_2l,jend_2u + do i=1,im + smstav(i,j) = spval + sfcevp(i,j) = spval + acsnow(i,j) = spval + acsnom(i,j) = spval + qz0(i,j) = spval + uz0(i,j) = spval + vz0(i,j) = spval + maxrhshltr(i,j) = SPVAL + minrhshltr(i,j) = SPVAL + enddo + enddo + +! GFS does not have mixing length,el_pbl +! exchange coefficient, exch_h + do l=1,lm +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) + do j=jsta_2l,jend_2u + do i=1,im + el_pbl(i,j,l) = spval + exch_h(i,j,l) = spval + enddo + enddo + enddo + +! GFS does not have deep convective cloud top and bottom fields +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp& shared(htopd,hbotd,htops,hbots,cuppt) + do j=jsta_2l,jend_2u + do i=1,im + htopd(i,j) = SPVAL + hbotd(i,j) = SPVAL + htops(i,j) = SPVAL + hbots(i,j) = SPVAL + cuppt(i,j) = SPVAL + enddo + enddo +! +! get inital date + sdat(1) = wrt_int_state%idate(2) !month + sdat(2) = wrt_int_state%idate(3) !day + sdat(3) = wrt_int_state%idate(1) !year + ihrst = wrt_int_state%idate(4) !hour + + idat(1) = wrt_int_state%fdate(2) + idat(2) = wrt_int_state%fdate(3) + idat(3) = wrt_int_state%fdate(1) + idat(4) = wrt_int_state%fdate(4) + idat(5) = wrt_int_state%fdate(5) +! + if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst +! CALL W3DIFDAT(JDATE,IDATE,0,RINC) +! +! if(mype==0)print *,' rinc=',rinc +! ifhr = nint(rinc(2)+rinc(1)*24.) +! if(mype==0)print *,' ifhr=',ifhr +! ifmin = nint(rinc(3)) +! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop +! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin +! + tstart = 0. +! +!** initialize cloud water and ice mixing ratio +!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & +!$omp& shared(qqw,qqr,qqs,qqi) + do l = 1,lm + do j = jsta, jend + do i = 1,im + qqw(i,j,l) = 0. + qqr(i,j,l) = 0. + qqs(i,j,l) = 0. + qqi(i,j,l) = 0. + enddo + enddo + enddo +! +!----------------------------------------------------------------------------- +! get post fields +!----------------------------------------------------------------------------- +! + foundland = .false. + foundice = .false. + get_lsmsk: do ibdl=1, wrt_int_state%FBCount + +! find lans sea mask + found = .false. + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found + if (found) then + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ista = lbound(arrayr42d,1) + iend = ubound(arrayr42d,1) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + do j=jsta, jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) + enddo + enddo + foundland = .true. + endif + +! find ice fraction + found = .false. + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found + if (found) then + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) + iend = ubound(arrayr42d,1) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + do j=jsta, jend + do i=ista, iend + sice(i,j) = arrayr42d(i,j) + if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 + enddo + enddo + foundice = .true. + endif + + enddo get_lsmsk + if (.not.foundland .or. .not.foundice) then + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount +! + file_loop_all: do ibdl=1, wrt_int_state%FBCount +! +! get grid dimension count +! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & +! ista,iend,'jdim=',jsta,jend + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) + allocate(fcstField(ncount_field)) + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + + do n=1, ncount_field +! + call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (index(trim(fieldname),"vector") >0) cycle +! +!** for 2D fields + if (fieldDimCount == 2) then + + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + allocate( arrayr42d(ista:iend,jsta:jend)) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + do j=jsta, jend + do i=ista, iend + arrayr42d(i,j) = arrayr82d(i,j) + enddo + enddo + endif + + ! Terrain height (*G later) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + do j=jsta,jend + do i=ista, iend + fis(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! Surface pressure +! if(trim(fieldname)=='pressfc') then +!!$omp parallel do private(i,j) +! do j=jsta,jend +! do i=ista, iend +! pint(i,j) = arrayr42d(i,j) +! enddo +! enddo +! endif + + ! PBL height using nemsio + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + do j=jsta,jend + do i=ista, iend + pblh(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! frictional velocity + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + do j=jsta,jend + do i=ista, iend + ustar(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! roughness length + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + do j=jsta,jend + do i=ista, iend + z0(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! sfc exchange coeff + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcexc(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! aerodynamic conductance + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + do j=jsta,jend + do i=ista, iend + acond(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! surface potential T + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + ths(i,j) = arrayr42d(i,j) + endif + enddo + enddo + endif + + ! convective precip in m per physics time step + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) & + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + enddo + enddo + endif + + ! continuous bucket convective precip in m per physics time step + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + endif + enddo + enddo + endif + + ! time averaged bucketed precip rate + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgprec(i,j) = arrayr42d(i,j) * dtq2001 + endif + enddo + enddo + endif + + ! time averaged continuous precip rate in m per physics time step + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + endif + enddo + enddo + endif + + ! precip rate in m per physics time step + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + endif + enddo + enddo + endif + + ! convective precip rate in m per physics time step + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + endif + enddo + enddo + endif + + ! inst snow water eqivalent + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + sno(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + enddo + enddo + endif + + ! ave snow cover + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + snoavg(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. + enddo + enddo + endif + + ! snow depth in mm + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + si(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 + enddo + enddo + endif + + ! 2m potential T (computed later) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + tshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! surface potential T + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + qshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! mid day avg albedo in fraction + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgalbedo(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgalbedo(i,j) = avgalbedo(i,j) * 0.01 + endif + enddo + enddo + endif + + ! time averaged column cloud fraction + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgtcdc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgtcdc(i,j) = avgtcdc(i,j) * 0.01 + endif + enddo + enddo + endif + + ! maximum snow albedo in fraction + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + do j=jsta,jend + do i=ista, iend + mxsnal(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + mxsnal(i,j) = mxsnal(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave high cloud fraction + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfrach(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfrach(i,j) = avgcfrach(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave low cloud fraction + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfracl(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfracl(i,j) = avgcfracl(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave middle cloud fraction + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfracm(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfracm(i,j) = avgcfracm(i,j) * 0.01 + endif + enddo + enddo + endif + + ! inst convective cloud fraction + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + do j=jsta,jend + do i=ista, iend + cnvcfr(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + cnvcfr(i,j) = cnvcfr(i,j) * 0.01 + endif + enddo + enddo + endif + + ! slope type + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + islope(i,j) = nint(arrayr42d(i,j)) + else + islope(i,j) = 0 + endif + enddo + enddo + endif + + ! time averaged column cloud fraction + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + cmc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 + if (sm(i,j) /= 0.0) cmc(i,j) = spval + enddo + enddo + endif + + ! frozen precip fraction + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + !set range within (0,1) + sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) + else + sr(i,j) = spval + endif + enddo + enddo + endif + + ! sea ice skin temperature + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + do j=jsta,jend + do i=ista,iend + if (arrayr42d(i,j) /= spval) then + ti(i,j) = arrayr42d(i,j) + if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval + else + ti(i,j) = spval + endif + enddo + enddo + endif + + ! vegetation fraction + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + vegfrc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + vegfrc(i,j) = vegfrc(i,j) * 0.01 + else + vegfrc(i,j) = 0.0 + endif + if (sm(i,j) /= 0.0) vegfrc(i,j) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,1) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,2) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,3) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,4) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,1) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,1) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,2) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,2) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,3) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,3) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,4) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,4) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,1) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,2) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,3) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,4) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval + enddo + enddo + endif + + ! time averaged incoming sfc longwave + if(trim(fieldname)=='dlwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! inst incoming sfc longwave + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + do j=jsta,jend + do i=ista, iend + rlwin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwout(i,j) = arrayr42d(i,j) + if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) + enddo + enddo + endif + + ! inst outgoing sfc longwave + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + do j=jsta,jend + do i=ista, iend + radot(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing model top longwave + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwtoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc shortwave + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! inst incoming sfc shortwave + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + rswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc uv-b + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + do j=jsta,jend + do i=ista, iend + auvbin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc clear sky uv-b + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + auvbinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswout(i,j) = arrayr42d(i,j) + if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) + enddo + enddo + endif + + ! inst outgoing sfc shortwave + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + do j=jsta,jend + do i=ista, iend + rswout(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged model top incoming shortwave + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswintoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! ime averaged model top outgoing shortwave + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswtoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface sensible heat flux, multiplied by -1 because + ! wrf model fluxhas reversed sign convention using gfsio + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcshx(i,j) = arrayr42d(i,j) + if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) + enddo + enddo + endif + + ! inst surface sensible heat flux + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + do j=jsta,jend + do i=ista, iend + twbs(i,j) = arrayr42d(i,j) + if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) + enddo + enddo + endif + + ! time averaged surface latent heat flux, multiplied by -1 because + ! wrf model flux has reversed sign vonvention using gfsio + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfclhx(i,j) = arrayr42d(i,j) + if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) + enddo + enddo + endif + + ! inst surface latent heat flux + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + do j=jsta,jend + do i=ista, iend + qwbs(i,j) = arrayr42d(i,j) + if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) + enddo + enddo + endif + + ! time averaged ground heat flux + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + subshx(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + enddo + enddo + endif + + ! inst ground heat flux + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + grnflx(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + enddo + enddo + endif + + ! time averaged zonal momentum flux + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcux(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged meridional momentum flux + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcvx(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged zonal gravity wave stress + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + do j=jsta,jend + do i=ista, iend + gtaux(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged meridional gravity wave stress + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + do j=jsta,jend + do i=ista, iend + gtauy(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged accumulated potential evaporation + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + avgpotevp(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + enddo + enddo + endif + + ! inst potential evaporation + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + potevp(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + enddo + enddo + endif + + ! 10 m u + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + do j=jsta,jend + do i=ista, iend + u10(i,j) = arrayr42d(i,j) + u10h(i,j) = u10(i,j) + enddo + enddo + endif + + ! 10 m v + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + do j=jsta,jend + do i=ista, iend + v10(i,j) = arrayr42d(i,j) + v10h(i,j) = v10(i,j) + enddo + enddo + endif + + ! vegetation type + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + ivgtyp(i,j) = nint(arrayr42d(i,j)) + else + ivgtyp(i,j) = 0 + endif + enddo + enddo + endif + + ! soil type + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + isltyp(i,j) = nint(arrayr42d(i,j)) + else + isltyp(i,j) = 0 + endif + enddo + enddo + endif + + ! inst cloud top pressure + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptop(i,j) = arrayr42d(i,j) + if(ptop(i,j) <= 0.0) ptop(i,j) = spval + enddo + enddo + endif + + ! inst cloud bottom pressure + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbot(i,j) = arrayr42d(i,j) + if(pbot(i,j) <= 0.0) pbot(i,j) = spval + enddo + enddo + endif + + ! time averaged low cloud top pressure + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptopl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged low cloud bottom pressure + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbotl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged low cloud top temperature + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttopl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud top pressure + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptopm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud bottom pressure + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbotm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud top temperature + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttopm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud top pressure + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptoph(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud bottom pressure + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + do j=jsta,jend + do i=ista, iend + pboth(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud top temperature + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttoph(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged boundary layer cloud cover + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + do j=jsta,jend + do i=ista, iend + pblcfr(i,j) = arrayr42d(i,j) + if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 + enddo + enddo + endif + + ! cloud work function + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + do j=jsta,jend + do i=ista, iend + cldwork(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! water runoff + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + runoff(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) runoff(i,j) = spval + enddo + enddo + endif + + ! shelter max temperature + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + maxtshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter min temperature + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + mintshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! ice thickness + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + do j=jsta,jend + do i=ista, iend + dzice(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! wilting point + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smcwlt(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smcwlt(i,j) = spval + enddo + enddo + endif + + ! sunshine duration + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + do j=jsta,jend + do i=ista, iend + suntime(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! field capacity + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + fieldcapa(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval + enddo + enddo + endif + + ! time averaged surface visible beam downward solar flux + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + avisbeamswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface visible diffuse downward solar flux + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + avisdiffswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface near IR beam downward solar flux + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + airbeamswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface near IR diffuse downward solar flux + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + airdiffswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky outgoing LW + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwoutc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged TOA clear sky outgoing LW + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwtoac(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky outgoing SW + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswoutc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged TOA clear sky outgoing SW + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswtoac(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky incoming LW + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky incoming SW + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter max specific humidity + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + maxqshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter min temperature + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + minqshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! storm runoffs + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + ssroff(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) ssroff(i,j) = spval + enddo + enddo + endif + + ! direct soil evaporation + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgedir(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgedir(i,j) = spval + enddo + enddo + endif + + ! canopy water evap + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgecan(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgecan(i,j) = spval + enddo + enddo + endif + + ! plant transpiration + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgetrans(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgetrans(i,j) = spval + enddo + enddo + endif + + ! snow sublimation + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + avgesnow(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + enddo + enddo + endif + + ! total soil moisture + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smstot(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smstot(i,j) = spval + enddo + enddo + endif + + ! snow phase change heat flux + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + snopcx(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) snopcx(i,j) = spval + enddo + enddo + endif + +! else if (fieldDimCount > gridDimCount) then + else if (fieldDimCount == 3) then + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) + arrayr43d = 0. + do k=kstart,kend +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + do j=jsta,jend + do i=ista,iend + arrayr43d(i,j,k) = arrayr83d(i,j,k) + enddo + enddo + enddo + endif + + ! model level T + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + t(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + + !! sig4 +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + do j=jsta,jend + do i=ista, iend + tlmh = t(i,j,lm) * t(i,j,lm) + sigt4(i,j) = 5.67E-8 * tlmh * tlmh + enddo + enddo + endif + + ! model level spfh + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + q(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level u wind + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + uh(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level v wind + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + vh(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level pressure thinkness + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + dpres(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level gh thinkness, model output negative delz + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + zint(i,j,l) = -arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level w + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + wh(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ozone mixing ratio + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + o3(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + +! for GFDL or MG3 MP +! ------------------ + if (imp_physics == 10 .or. imp_physics == 11) then + ! model level cloud water mixing ratio + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqi(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqs(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqns(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif ! for MG3 MP + + ! model level cloud amount + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + cfr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ref3d + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + ref_10cm(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo +! print *,'in gfs_post, get ref_10cm=',maxval(ref_10cm), minval(ref_10cm) + endif + + ! model level ref3d + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + q2(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif +!3d fields + endif + + enddo ! end loop ncount_field + + if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & + setvar_atmfile = .true. + if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) & + setvar_sfcfile = .true. + deallocate(fcstField) + +! end file_loop_all + enddo file_loop_all + +! recompute full layer of zint +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) + do j=jsta,jend + do i=1,im + if (fis(i,j) /= spval) then + zint(i,j,lp1) = fis(i,j) + fis(i,j) = fis(i,j) * grav + endif + enddo + enddo + + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) + do j=jsta,jend + do i=1,im + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) + enddo + enddo + enddo + +! compute pint from top down +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) + do j=jsta,jend + do i=1,im + pint(i,j,1) = ak5(1) + pd(i,j) = spval + enddo + enddo + + do l=2,lp1 + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) + do j=jsta,jend + do i=1,im + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) +!compute pmid from averaged two layer pint + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + enddo + enddo + enddo + +! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) + +! compute alpint + do l=lp1,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) + do j=jsta,jend + do i=1,im + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo + +! compute zmid + do l=lm,1,-1 + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) + do j=jsta,jend + do i=1,im + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo +! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & +! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & +! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & +! 'pmid=',maxval(pmid(1:im,jsta:jend,1)),minval(pmid(1:im,jsta:jend,1)), & +! 'alpint=',maxval(alpint(1:im,jsta:jend,2)),minval(alpint(1:im,jsta:jend,2)) +! print *,'in post_gfs,alpint=',maxval(alpint(1:im,jsta:jend,1)), & +! minval(alpint(1:im,jsta:jend,1)) + +! surface potential T, and potential T at roughness length +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,lp1,sm,ths,sst,thz0,pint) + do j=jsta,jend + do i=ista, iend + !assign sst + if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then + sst(i,j) = ths(i,j) + else + sst(i,j) = spval + endif + if (ths(i,j) /= spval) then + ths(i,j) = ths(i,j)* (p1000/pint(i,j,lp1))**capa + thz0(i,j) = ths(i,j) + endif + enddo + enddo + +! compute cwm for gfdlmp or MG3 + if( imp_physics == 10 .or. imp_physics == 11) then + do l=1,lm +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) + do j=jsta,jend + do i=ista,iend + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + enddo + enddo + enddo + endif + +! estimate 2m pres and convert t2m to theta +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) + do j=jsta,jend + do i=ista, iend + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + enddo + enddo + +!htop + do j=jsta,jend + do i=1,im + htop(i,j) = spval + if(ptop(i,j) < spval)then + do l=1,lm + if(ptop(i,j) <= pmid(i,j,l))then + htop(i,j) = l + exit + endif + enddo + endif + enddo + enddo + +! hbot + do j=jsta,jend + do i=1,im + if(pbot(i,j) < spval)then + do l=lm,1,-1 + if(pbot(i,j) >= pmid(i,j,l)) then + hbot(i,j) = l + exit + end if + end do + end if + end do + end do + +! generate look up table for lifted parcel calculations + thl = 210. + plq = 70000. + pt_tbl = 10000. ! this is for 100 hPa added by Moorthi + + call table(ptbl,ttbl,pt_tbl, & + rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0) + + call tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q) + + if(mype == 0)then + write(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' + write(6,51) (SPL(L),L=1,LSM) + 50 format(14(F4.1,1X)) + 51 format(8(F8.1,1X)) + endif +! +!$omp parallel do default(none) private(l) shared(lsm,alsl,spl) + do l = 1,lsm + alsl(l) = log(spl(l)) + end do +! +! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) +!!! above is fv3 change +! +!more fields need to be computed +! + end subroutine set_postvars_gfs + + + end module post_gfs From 20a31c4b8acb5232476b9b9cf559b7a0c988dbd9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 4 Dec 2020 01:29:25 +0000 Subject: [PATCH 108/217] some update to snow depth calculation and output --- .gitmodules | 2 +- atmos_model.F90 | 6 +++-- gfsphysics/GFS_layer/GFS_diagnostics.F90 | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 21 +++++++++-------- .../GFS_layer/GFS_physics_driver.F90_clean | 23 +++++++++++-------- 5 files changed, 32 insertions(+), 22 deletions(-) diff --git a/.gitmodules b/.gitmodules index 7f43434b4..fc93fae14 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Nov192020 + branch = SM_Dec022020 diff --git a/atmos_model.F90 b/atmos_model.F90 index 051f5918d..acc8e8464 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -963,7 +963,9 @@ subroutine atmos_model_end (Atmos) call atmosphere_end (Atmos % Time, Atmos%grid, restart_endfcst) +#ifdef CCPP call stochastic_physics_wrapper_end(IPD_Control) +#endif if(restart_endfcst) then call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, & @@ -1958,8 +1960,8 @@ 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) - IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & - / max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix)) +! IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) & +! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix)) ! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix)) IPD_Data(nb)%Sfcprop%zorli(ix) = z0ice else diff --git a/gfsphysics/GFS_layer/GFS_diagnostics.F90 b/gfsphysics/GFS_layer/GFS_diagnostics.F90 index a289df88a..e02d48fdd 100644 --- a/gfsphysics/GFS_layer/GFS_diagnostics.F90 +++ b/gfsphysics/GFS_layer/GFS_diagnostics.F90 @@ -3018,7 +3018,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'snowd' ExtDiag(idx)%desc = 'surface snow depth' - ExtDiag(idx)%unit = 'm' + ExtDiag(idx)%unit = 'mm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one/cn_th allocate (ExtDiag(idx)%data(nblks)) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 7839ce70e..ab31eab05 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1273,7 +1273,7 @@ subroutine GFS_physics_driver & zorl3(i,1) = Sfcprop%zorll(i) tsfc3(i,1) = Sfcprop%tsfcl(i) tsurf3(i,1) = Sfcprop%tsfcl(i) - snowd3(i,1) = Sfcprop%snowd(i) + snowd3(i,1) = Sfcprop%snowd(i) / frland(i) semis3(i,1) = Radtend%semis(i) endif ! @@ -1284,7 +1284,7 @@ subroutine GFS_physics_driver & tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) tice(i) = Sfcprop%tisfc(i) - snowd3(i,2) = Sfcprop%snowd(i) + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) ep1d3(i,2) = zero gflx3(i,2) = zero semis3(i,2) = 0.95_kind_phys @@ -2232,6 +2232,7 @@ subroutine GFS_physics_driver & Sfcprop%tsfco(i) = tsfc3(i,1) Sfcprop%tisfc(i) = tsfc3(i,1) Sfcprop%tsfc(i) = tsfc3(i,1) + Sfcprop%snowd(i) = snowd3(i,1) elseif (islmsk(i) == 0) then k = 3 stress(i) = stress3(i,3) @@ -2240,6 +2241,7 @@ subroutine GFS_physics_driver & Sfcprop%tisfc(i) = tsfc3(i,3) Sfcprop%tsfcl(i) = tsfc3(i,3) Sfcprop%tsfc(i) = tsfc3(i,3) + Sfcprop%snowd(i) = zero else k = 2 stress(i) = stress3(i,2) @@ -2279,13 +2281,14 @@ subroutine GFS_physics_driver & if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice txi = fice(i) txo = one - txi - evap(i) = txi * evap3(i,2) + txo * evap3(i,3) - hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) - Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) - stress(i) = txi *stress3(i,2) + txo * stress3(i,3) - qss(i) = txi * qss3(i,2) + txo * qss3(i,3) - ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) - Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + evap(i) = txi * evap3(i,2) + txo * evap3(i,3) + hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) + Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) + stress(i) = txi *stress3(i,2) + txo * stress3(i,3) + qss(i) = txi * qss3(i,2) + txo * qss3(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) + Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + Sfcprop%snowd(i) = txi * snowd3(i,2) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean index 82f973b3e..51f871686 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -1103,6 +1103,8 @@ module module_physics_driver else ! all land fice(i) = zero zice(i) = zero + islmsk(i) = 1 + islmsk_cice(i) = 1 endif enddo else @@ -1213,7 +1215,7 @@ module module_physics_driver zorl3(i,1) = Sfcprop%zorll(i) tsfc3(i,1) = Sfcprop%tsfcl(i) tsurf3(i,1) = Sfcprop%tsfcl(i) - snowd3(i,1) = Sfcprop%snowd(i) + snowd3(i,1) = Sfcprop%snowd(i) / frland(i) semis3(i,1) = Radtend%semis(i) endif ! @@ -1224,7 +1226,7 @@ module module_physics_driver tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) tice(i) = Sfcprop%tisfc(i) - snowd3(i,2) = Sfcprop%snowd(i) + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) ep1d3(i,2) = zero gflx3(i,2) = zero semis3(i,2) = 0.95_kind_phys @@ -2112,6 +2114,7 @@ module module_physics_driver Sfcprop%tsfco(i) = tsfc3(i,1) Sfcprop%tisfc(i) = tsfc3(i,1) Sfcprop%tsfc(i) = tsfc3(i,1) + Sfcprop%snowd(i) = snowd3(i,1) elseif (islmsk(i) == 0) then k = 3 stress(i) = stress3(i,3) @@ -2120,6 +2123,7 @@ module module_physics_driver Sfcprop%tisfc(i) = tsfc3(i,3) Sfcprop%tsfcl(i) = tsfc3(i,3) Sfcprop%tsfc(i) = tsfc3(i,3) + Sfcprop%snowd(i) = zero else k = 2 stress(i) = stress3(i,2) @@ -2159,13 +2163,14 @@ module module_physics_driver if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice txi = fice(i) txo = one - txi - evap(i) = txi * evap3(i,2) + txo * evap3(i,3) - hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) - Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) - stress(i) = txi *stress3(i,2) + txo * stress3(i,3) - qss(i) = txi * qss3(i,2) + txo * qss3(i,3) - ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) - Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + evap(i) = txi * evap3(i,2) + txo * evap3(i,3) + hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) + Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) + stress(i) = txi *stress3(i,2) + txo * stress3(i,3) + qss(i) = txi * qss3(i,2) + txo * qss3(i,3) + ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3) + Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3) + Sfcprop%snowd(i) = txi * snowd3(i,2) endif elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) From 8d9ce62c9088ebdee5cf1198d5eae087f67f405c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 5 Dec 2020 00:28:40 +0000 Subject: [PATCH 109/217] some update to physics driver --- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 31 +++++++++++++++++-- .../GFS_layer/GFS_physics_driver.F90_clean | 31 +++++++++++++++++-- 4 files changed, 60 insertions(+), 6 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 620941b7d..211d8da10 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 620941b7dd01c6fccab5cb00f5955216f681f30f +Subproject commit 211d8da10b367408f197e04716097c057100bf02 diff --git a/ccpp/physics b/ccpp/physics index 0817a048b..aa2b98be6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0817a048beb0ae2c1dc7699933a009427613849c +Subproject commit aa2b98be6b22c5fdbf4782baf5269aad26168a3e diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index ab31eab05..1d492307f 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1273,7 +1273,7 @@ subroutine GFS_physics_driver & zorl3(i,1) = Sfcprop%zorll(i) tsfc3(i,1) = Sfcprop%tsfcl(i) tsurf3(i,1) = Sfcprop%tsfcl(i) - snowd3(i,1) = Sfcprop%snowd(i) / frland(i) +! snowd3(i,1) = Sfcprop%snowd(i) / frland(i) semis3(i,1) = Radtend%semis(i) endif ! @@ -1284,13 +1284,40 @@ subroutine GFS_physics_driver & tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) tice(i) = Sfcprop%tisfc(i) - snowd3(i,2) = Sfcprop%snowd(i) / fice(i) +! snowd3(i,2) = Sfcprop%snowd(i) / fice(i) ep1d3(i,2) = zero gflx3(i,2) = zero semis3(i,2) = 0.95_kind_phys endif if (nint(Sfcprop%slmsk(i)) /= 1) Sfcprop%slmsk(i) = islmsk(i) enddo +! + if (Model%frac_grid) then + do i=1,im + if (dry(i)) then + if (icy(i)) then + snowd3(i,1) = Sfcprop%snowd(i) / (frland(i) + fice(i)) + snowd3(i,2) = snowd3(i,2) + else + snowd3(i,1) = Sfcprop%snowd(i) / frland(i) + snowd3(i,2) = zero + endif + elseif (icy(i)) then + snowd3(i,1) = zero + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) + endif + enddo + else + do i=1,im + if (dry(i)) then + snowd3(i,1) = Sfcprop%snowd(i) + snowd3(i,2) = zero + elseif (icy(i)) then + snowd3(i,1) = zero + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) + endif + enddo + endif !*## CCPP ## !## CCPP ## global to local variable transfer not necessary for these variables diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean index 51f871686..c697cd493 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90_clean @@ -1215,7 +1215,7 @@ module module_physics_driver zorl3(i,1) = Sfcprop%zorll(i) tsfc3(i,1) = Sfcprop%tsfcl(i) tsurf3(i,1) = Sfcprop%tsfcl(i) - snowd3(i,1) = Sfcprop%snowd(i) / frland(i) +! snowd3(i,1) = Sfcprop%snowd(i) / frland(i) semis3(i,1) = Radtend%semis(i) endif ! @@ -1226,13 +1226,40 @@ module module_physics_driver tsfc3(i,2) = Sfcprop%tisfc(i) tsurf3(i,2) = Sfcprop%tisfc(i) tice(i) = Sfcprop%tisfc(i) - snowd3(i,2) = Sfcprop%snowd(i) / fice(i) +! snowd3(i,2) = Sfcprop%snowd(i) / fice(i) ep1d3(i,2) = zero gflx3(i,2) = zero semis3(i,2) = 0.95_kind_phys endif if (nint(Sfcprop%slmsk(i)) /= 1) Sfcprop%slmsk(i) = islmsk(i) enddo +! + if (Model%frac_grid) then + do i=1,im + if (dry(i)) then + if (icy(i)) then + snowd3(i,1) = Sfcprop%snowd(i) / (frland(i) + fice(i)) + snowd3(i,2) = snowd3(i,2) + else + snowd3(i,1) = Sfcprop%snowd(i) / frland(i) + snowd3(i,2) = zero + endif + elseif (icy(i)) then + snowd3(i,1) = zero + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) + endif + enddo + else + do i=1,im + if (dry(i)) then + snowd3(i,1) = Sfcprop%snowd(i) + snowd3(i,2) = zero + elseif (icy(i)) then + snowd3(i,1) = zero + snowd3(i,2) = Sfcprop%snowd(i) / fice(i) + endif + enddo + endif ! --- ... transfer soil moisture and temperature from global to local variables do k=1,lsoil From 71a5e23899523a8bb790857ca9827015f84b0de5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 8 Dec 2020 20:18:42 -0500 Subject: [PATCH 110/217] fixing a bug --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index aa2b98be6..d4ececd7b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit aa2b98be6b22c5fdbf4782baf5269aad26168a3e +Subproject commit d4ececd7b35dc109b16a5db85806efde26e437ea diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 2bc70c6c9..229066500 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -968,11 +968,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif #endif !--- register the 3D fields - if (Model%frac_grid) then +! if (Model%frac_grid) then sfc_name3(0) = 'tiice' var3_p => sfc_var3ice(:,:,:) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.) - end if +! end if do num = 1,nvar_s3 var3_p => sfc_var3(:,:,:,num) @@ -2094,11 +2094,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta #endif !--- register the 3D fields - if (Model%frac_grid) then +! if (Model%frac_grid) then sfc_name3(0) = 'tiice' var3_p => sfc_var3ice(:,:,:) id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain) - endif +! endif do num = 1,nvar3 var3_p => sfc_var3(:,:,:,num) From bf81a67ef69a5c4ff3ab86223efccdec886890d6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 10 Dec 2020 19:47:35 -0500 Subject: [PATCH 111/217] after syncing submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index d4ececd7b..217b91ae0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d4ececd7b35dc109b16a5db85806efde26e437ea +Subproject commit 217b91ae0c7e05265c731ff4769cfa2d4efb0bc5 From 467a5384a24759c92ecd129db57a8c0b08f0fa3c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 17 Dec 2020 02:43:34 +0000 Subject: [PATCH 112/217] reveerting to my version of post_gfs --- io/post_gfs.F90 | 922 ++++++++-------- io/post_gfs.F90_v16 | 2473 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 2953 insertions(+), 442 deletions(-) create mode 100644 io/post_gfs.F90_v16 diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 76dd0251c..248ce6d06 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -112,19 +112,20 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -137,16 +138,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. + setvar_atmfile = .false. + setvar_sfcfile = .false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP +! 20190807 need to call microinit only for Ferrier microphysics ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -239,66 +240,62 @@ subroutine post_getattr_gfs(wrt_int_state, fldbundle) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n>1) then + else if(n > 1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then + else if(trim(attName) == "bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n>1) then - if(trim(attName) =="ak") then + else if(n > 1) then + if(trim(attName) == "ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -332,7 +329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -360,11 +358,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -389,12 +387,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -473,7 +471,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -484,7 +482,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -496,10 +494,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -507,6 +505,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs + dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -514,22 +513,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL - enddo - enddo -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? enddo enddo @@ -604,7 +597,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -720,19 +713,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -744,19 +737,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -768,9 +759,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -778,29 +768,27 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -808,14 +796,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -824,58 +812,58 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j)=arrayr42d(i,j) + fis(i,j) = arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) +!!$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend -! pint(i,j)=arrayr42d(i,j) +! pint(i,j) = arrayr42d(i,j) ! enddo ! enddo ! endif ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j)=arrayr42d(i,j) + pblh(i,j) = arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j)=arrayr42d(i,j) + ustar(i,j) = arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j)=arrayr42d(i,j) + z0(i,j) = arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -884,18 +872,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j)=arrayr42d(i,j) + acond(i,j) = arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -906,114 +894,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1022,8 +1010,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1032,8 +1020,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1045,8 +1033,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1058,8 +1046,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1071,8 +1059,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1084,8 +1072,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1097,8 +1085,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1110,8 +1098,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1123,8 +1111,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1137,8 +1125,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1149,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1164,8 +1152,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1179,8 +1167,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1195,8 +1183,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1206,8 +1194,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1217,8 +1205,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1228,8 +1216,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1239,8 +1227,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1250,8 +1238,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1261,8 +1249,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1272,8 +1260,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1283,8 +1271,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1295,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1307,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1319,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1332,7 +1320,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1341,8 +1329,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1351,8 +1339,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1362,8 +1350,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1372,8 +1360,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1382,8 +1370,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1392,8 +1380,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1402,8 +1390,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1412,8 +1400,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1422,8 +1410,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1433,8 +1421,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1443,8 +1431,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1453,8 +1441,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1464,8 +1452,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1475,8 +1463,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1487,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1498,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1509,30 +1497,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1541,8 +1529,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1551,8 +1539,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1561,8 +1549,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1571,30 +1559,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1604,8 +1592,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1615,8 +1603,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1629,8 +1617,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1643,8 +1631,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1654,8 +1642,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1665,8 +1653,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1675,8 +1663,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1685,8 +1673,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1695,8 +1683,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1705,8 +1693,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1715,8 +1703,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1725,8 +1713,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1735,8 +1723,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1745,8 +1733,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1755,8 +1743,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1766,8 +1754,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1776,8 +1764,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1787,8 +1775,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1797,8 +1785,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1807,8 +1795,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1817,8 +1805,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1828,8 +1816,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1838,8 +1826,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1849,8 +1837,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1859,8 +1847,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1869,8 +1857,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1879,8 +1867,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1889,8 +1877,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1899,8 +1887,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1909,8 +1897,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1919,8 +1907,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1929,8 +1917,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1939,8 +1927,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1949,8 +1937,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1959,8 +1947,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1969,8 +1957,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1980,8 +1968,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1991,8 +1979,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2002,8 +1990,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2013,19 +2001,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval enddo enddo endif ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2035,8 +2023,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2046,19 +2034,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then + else if (fieldDimCount == 3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2068,8 +2054,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2079,7 +2065,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2089,172 +2075,237 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) + q(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) + uh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) + vh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) + dpres(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) + zint(i,j,l) = -arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) + wh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) + o3(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL MP - if (imp_physics == 11) then +! for GFDL or MG3 MP +! ------------------ + if (imp_physics == 10 .or. imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) + qqw(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) + qqi(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) + qqr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) + qqs(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqns(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -!gfdlmp - endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif ! for MG3 MP ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) + cfr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) + ref_10cm(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2262,12 +2313,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) + q2(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2275,8 +2326,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif -! end loop ncount_field - enddo + enddo ! end loop ncount_field if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2302,46 +2352,33 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - end do - end do + pd(i,j) = spval + enddo + enddo do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) !compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) enddo enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2349,22 +2386,23 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2390,13 +2428,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp - if( imp_physics == 11 ) then +! compute cwm for gfdlmp or MG3 + if( imp_physics == 10 .or. imp_physics == 11) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) enddo enddo enddo @@ -2406,8 +2444,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2418,13 +2456,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l + htop(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! hbot do j=jsta,jend diff --git a/io/post_gfs.F90_v16 b/io/post_gfs.F90_v16 new file mode 100644 index 000000000..76dd0251c --- /dev/null +++ b/io/post_gfs.F90_v16 @@ -0,0 +1,2473 @@ +!----------------------------------------------------------------------- +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +!----------------------------------------------------------------------- +! +module post_gfs + + use module_fv3_io_def, only : wrttasks_per_group,filename_base + use write_internal_state, only : wrt_internal_state + + implicit none + + include 'mpif.h' + + integer mype, nbdl + logical setvar_atmfile, setvar_sfcfile, read_postcntrl + public post_run_gfs, post_getattr_gfs + + contains + + subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & + mynfhr,mynfmin,mynfsec) +! +! revision history: +! Jul 2019 J. Wang create interface to run inline post for FV3 +! +!----------------------------------------------------------------------- +!*** run post on write grid comp +!----------------------------------------------------------------------- +! + use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & + npset,grib,gocart_on,icount_calmict, jsta, & + jend,im, nsoil, filenameflat + use gridspec_mod, only : maptype, gridtype + use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl + use xml_perl_data,only : paramset +! +!----------------------------------------------------------------------- +! + implicit none +! +!----------------------------------------------------------------------- +! + type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: mypei + integer,intent(in) :: mpicomp + integer,intent(in) :: lead_write + integer,intent(in) :: mynfhr + integer,intent(in) :: mynfmin + integer,intent(in) :: mynfsec +! +!----------------------------------------------------------------------- +!*** LOCAL VARIABLES +!----------------------------------------------------------------------- +! + integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil + integer,allocatable :: jstagrp(:),jendgrp(:) + integer,save :: kpo,kth,kpv + logical,save :: log_postalct=.false. + real,dimension(komax),save :: po, th, pv + logical :: Log_runpost + character(255) :: post_fname*255 + + integer,save :: iostatusD3D=-1 +! + real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 +! +! print *,'in post_run start' +!----------------------------------------------------------------------- +!*** set up dimensions +!----------------------------------------------------------------------- +! + btim0 = MPI_Wtime() + + modelname = "GFS" + grib = "grib2" + gridtype = "A" + nsoil = 4 + mype = mypei + nwtpg = wrt_int_state%petcount + jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection + jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection + maptype = wrt_int_state%post_maptype + nbdl = wrt_int_state%FBCount + + if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & + 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct + +! +!----------------------------------------------------------------------- +!*** set up fields to run post +!----------------------------------------------------------------------- +! + if (.not.log_postalct) then +! + allocate(jstagrp(nwtpg),jendgrp(nwtpg)) +! + do n=0,nwtpg-1 + jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) + jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) + enddo + if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp + +!----------------------------------------------------------------------- +!*** read namelist for pv,th,po +!----------------------------------------------------------------------- +! + call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_nlunit, & + wrt_int_state%post_namelist) +! +!----------------------------------------------------------------------- +!*** allocate post variables +!----------------------------------------------------------------------- +! +! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! 'jstagrp=',jstagrp,'jendgrp=',jendgrp + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) +! +!----------------------------------------------------------------------- +!*** read namelist for pv,th,po +!----------------------------------------------------------------------- +! + log_postalct = .true. + first_grbtbl = .true. + read_postcntrl = .true. +! + ENDIF +! +!----------------------------------------------------------------------- +!*** fill post variables with values from forecast results +!----------------------------------------------------------------------- +! + ifhr = mynfhr + ifmin = mynfmin + if (ifhr == 0 ) ifmin = 0 + if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr + setvar_atmfile=.false. + setvar_sfcfile=.false. + call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & + setvar_sfcfile) + +! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & +! 'setvar_sfcfile=',setvar_sfcfile +! + if (setvar_atmfile.and.setvar_sfcfile) then +! 20190807 no need to call microinit for GFDLMP +! call MICROINIT +! + if(grib=="grib2" .and. read_postcntrl) then + if (ifhr == 0) then + filenameflat = 'postxconfig-NT_FH00.txt' + call read_xml() + if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat) + else if(ifhr > 0) then + filenameflat = 'postxconfig-NT.txt' + if(size(paramset)>0) then + do i=1,size(paramset) + if (size(paramset(i)%param)>0) then + deallocate(paramset(i)%param) + nullify(paramset(i)%param) + endif + enddo + deallocate(paramset) + nullify(paramset) + endif + num_pset = 0 + call read_xml() + if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr + read_postcntrl = .false. + endif + endif +! + IEOF = 0 + npset = 0 + icount_calmict = 0 + do while( IEOF == 0) +! + if(grib == "grib2") then + npset = npset + 1 + call set_outflds(kth,th,kpv,pv) + if(allocated(datapd))deallocate(datapd) + allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) +!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) + do k=1,nrecout+100 + do j=1,jend+1-jsta + do i=1,im + datapd(i,j,k) = 0. + enddo + enddo + enddo + call get_postfilename(post_fname) + if (mype==0) write(0,*)'post_fname=',trim(post_fname) +! + if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) +! + call mpi_barrier(mpicomp,ierr) + call gribit2(post_fname) + if(allocated(datapd))deallocate(datapd) + if(allocated(fld_info))deallocate(fld_info) + if(npset >= num_pset) exit + + endif +! + enddo +! + endif + + end subroutine post_run_gfs +! +!----------------------------------------------------------------------- +! + subroutine post_getattr_gfs(wrt_int_state, fldbundle) +! + use esmf + use ctlblk_mod, only: im, jm, mpi_comm_comp + use masks, only: gdlat, gdlon, dx, dy + use gridspec_mod, only: latstart, latlast, lonstart, & + lonlast, cenlon, cenlat +! + implicit none +! + type(wrt_internal_state),intent(inout) :: wrt_int_state + type(ESMF_FieldBundle), intent(in) :: fldbundle +! +! local variable + integer i,j,k,n,kz, attcount + integer ni,naryi,nr4,nr8,rc + integer aklen,varival + real(4) varr4val + real(8) varr8val + character(80) attName, hydrostatics, fldname + type(ESMF_TypeKind_Flag) :: typekind + real(4), dimension(:), allocatable :: ak4,bk4 + real(8), dimension(:), allocatable :: ak8,bk8 +! +! look at the field bundle attributes + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out +! + aklen=0. + do i=1, attCount + + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out + + if (typekind==ESMF_TYPEKIND_I4 ) then + if(n==1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + endif + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (trim(attName) == 'dtp') then + wrt_int_state%dtp=varr4val + endif + else if(n>1) then + if(trim(attName) =="ak") then + if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) + allocate(wrt_int_state%ak(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + wrt_int_state%lm = n-1 + else if(trim(attName) =="bk") then + if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) + allocate(wrt_int_state%bk(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + endif + endif + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), value=varr8val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (trim(attName) == 'dtp') then + wrt_int_state%dtp=varr8val + endif + else if(n>1) then + if(trim(attName) =="ak") then + if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) + allocate(wrt_int_state%ak(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + wrt_int_state%lm = n-1 + else if(trim(attName) =="bk") then + if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) + allocate(wrt_int_state%bk(n)) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + endif + wrt_int_state%lm = size(wrt_int_state%ak) - 1 + endif + endif +! + enddo +! print *,'in post_getattr, dtp=',wrt_int_state%dtp +! + end subroutine post_getattr_gfs +!----------------------------------------------------------------------- +!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +!----------------------------------------------------------------------- +! + subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & + setvar_sfcfile) +! +! revision history: +! Jul 2019 J. Wang Initial code +! +!----------------------------------------------------------------------- +!*** set up post fields from nmint_state +!----------------------------------------------------------------------- +! + use esmf + use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & + qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & + q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & + pint, exch_h, ref_10cm + use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& + qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& + cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& + avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, & + cfrach, cfracl, cfracm, avgcfrach, qshltr, & + avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& + vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & + bgroff, rlwin, & + rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & + rswinc, rswout, aswin, auvbin, auvbinc, aswout, & + aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & + sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & + smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & + acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & + htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & + pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& + maxtshltr, mintshltr, maxrhshltr, minrhshltr, & + dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & + htops, hbots, aswintoa, maxqshltr, minqshltr, & + acond, sr, u10h, v10h, avgedir, avgecan, & + avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& + avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & + alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& + avgpotevp, snoavg, ti, si, cuppt + use soil, only: sldpth, sh2o, smc, stc + use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice + use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst + use params_mod, only: erad, dtr, capa, p1000 + use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat + use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & + qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 + use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & + eps => con_eps, epsm1 => con_epsm1 + use rqstfld_mod +! +! use write_internal_state, only: wrt_internal_state +! +!----------------------------------------------------------------------- +! + implicit none +! + include 'mpif.h' +! +!----------------------------------------------------------------------- +! + type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: mpicomp + logical,intent(inout) :: setvar_atmfile,setvar_sfcfile +! +!----------------------------------------------------------------------- +! + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer ista,iend,fieldDimCount,gridDimCount,ncount_field + integer jdate(8) + logical foundland, foundice, found + real(4) rinc(5) + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real, dimension(:),allocatable :: ak5, bk5 + real(4),dimension(:,:),pointer :: arrayr42d + real(8),dimension(:,:),pointer :: arrayr82d + real(4),dimension(:,:,:),pointer :: arrayr43d + real(8),dimension(:,:,:),pointer :: arrayr83d + real,dimension(:), allocatable :: slat,qstl + real,external::FPVSNEW + real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & + cw2d, cfr2d + character(len=80) :: fieldname, wrtFBName + type(ESMF_Grid) :: wrtGrid + type(ESMF_Field) :: theField + type(ESMF_Field), allocatable :: fcstField(:) + type(ESMF_TypeKind_Flag) :: typekind +! +!----------------------------------------------------------------------- +!*** INTEGER SCALAR/1D HISTORY VARIABLES +!----------------------------------------------------------------------- +! + imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme + dtp = wrt_int_state%dtp + iSF_SURFACE_PHYSICS = 2 + spval = 9.99e20 + +! +! nems gfs has zhour defined + tprec = float(wrt_int_state%fhzero) + tclod = tprec + trdlw = tprec + trdsw = tprec + tsrfc = tprec + tmaxmin = tprec + td3d = tprec + if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & + 'dtp=',dtp,'tmaxmin=',tmaxmin + +! write(6,*) 'maptype and gridtype is ', maptype,gridtype +! +!$omp parallel do default(shared),private(i,j) + do j=jsta,jend + do i=1,im + gdlat(i,j) = wrt_int_state%latPtr(i,j) + gdlon(i,j) = wrt_int_state%lonPtr(i,j) + enddo + enddo +! + lonstart = nint(wrt_int_state%lonstart*gdsdegr) + lonlast = nint(wrt_int_state%lonlast*gdsdegr) + latstart = nint(wrt_int_state%latstart*gdsdegr) + latlast = nint(wrt_int_state%latlast*gdsdegr) +! print*,'latstart,latlast B bcast= ',latstart,latlast +! print*,'lonstart,lonlast B bcast= ',lonstart,lonlast + +!$omp parallel do default(none),private(i,j,ip1), & +!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) + do j = jsta, jend_m + do i = 1, im + ip1 = i + 1 + if (ip1 > im) ip1 = ip1 - im + dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr + dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH + end do + end do +! + if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) + do i=1,lm+1 + ak5(i) = wrt_int_state%ak(i) + bk5(i) = wrt_int_state%bk(i) + enddo + +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) + do j=jsta,jend + do i=1,im + f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) + end do + end do +! +! GFS does not output PD + pt = ak5(1) + +! GFS may not have model derived radar ref. +! TKE +! cloud amount +!$omp parallel do default(none),private(i,j,l), & +!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) + do l=1,lm + do j=jsta,jend + do i=1,im + ref_10cm(i,j,l) = SPVAL + q2(i,j,l) = SPVAL + cfr(i,j,l) = SPVAL + enddo + enddo + enddo + +! GFS does not have surface specific humidity +! inst sensible heat flux +! inst latent heat flux +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) + do j=jsta,jend + do i=1,im + qs(i,j) = SPVAL + twbs(i,j) = SPVAL + qwbs(i,j) = SPVAL + ths(i,j) = SPVAL + enddo + enddo + +! GFS set up DT to compute accumulated fields, set it to one + dtq2 = wrt_int_state%dtp + nphs = 2. + dt = dtq2/nphs +! +! GFS does not have convective cloud efficiency +! similated precip +! 10 m theta +! 10 m humidity +! snow free albedo +!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & +!$omp& shared(cldefi,lspa,th10,q10,albase) + do j=jsta,jend + do i=1,im + cldefi(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL + albase(i,j) = SPVAL + enddo + enddo + +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. + enddo + enddo + +! GFS probably does not use zenith angle, czen, czmean +! inst surface outgoing longwave, radot +! inst cloud fraction for high, middle, and low cloud, +! cfrach +! inst ground heat flux, grnflx +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & +!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) + do j=jsta,jend + do i=1,im + czen(i,j) = SPVAL + czmean(i,j) = SPVAL + radot(i,j) = SPVAL + cfrach(i,j) = SPVAL + cfracl(i,j) = SPVAL + cfracm(i,j) = SPVAL + grnflx(i,j) = SPVAL + enddo + enddo +! +! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam + sldpth(1) = 0.10 + sldpth(2) = 0.3 + sldpth(3) = 0.6 + sldpth(4) = 1.0 + +! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n +! cfrcv to 1 +! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 +! UNDERGROUND RUNOFF, bgroff +! inst incoming sfc longwave, rlwin +! inst model top outgoing longwave,rlwtoa +! inst incoming sfc shortwave, rswin +! inst incoming clear sky sfc shortwave, rswinc +! inst outgoing sfc shortwave, rswout +! snow phase change heat flux, snopcx +! GFS does not use total momentum flux,sfcuvx +!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & +!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) + do j=jsta,jend + do i=1,im + acfrcv(i,j) = spval + ncfrcv(i,j) = 1.0 + acfrst(i,j) = spval + ncfrst(i,j) = 1.0 + bgroff(i,j) = spval + rlwin(i,j) = spval + rlwtoa(i,j) = spval + rswin(i,j) = spval + rswinc(i,j) = spval + rswout(i,j) = spval + snopcx(i,j) = spval + sfcuvx(i,j) = spval + enddo + enddo + +! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 + ardlw = 1.0 +! GFS incoming sfc longwave has been averaged, set ARDLW to 1 + ardsw = 1.0 +! GFS surface flux has been averaged, set ASRFC to 1 + asrfc = 1.0 + +! GFS does not have temperature tendency due to long wave radiation +! temperature tendency due to short wave radiation +! temperature tendency due to latent heating from convection +! temperature tendency due to latent heating from grid scale + do l=1,lm +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & +!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) + do j=jsta_2l,jend_2u + do i=1,im + rlwtt(i,j,l) = spval + rswtt(i,j,l) = spval + tcucn(i,j,l) = spval + tcucns(i,j,l) = spval + train(i,j,l) = spval + enddo + enddo + enddo + +! set avrain to 1 + avrain = 1.0 + avcnvc = 1.0 + theat = 6.0 ! just in case GFS decides to output T tendency + +! GFS does not have temperature tendency due to latent heating from grid scale + train = spval + +! GFS does not have soil moisture availability, smstav +! accumulated surface evaporatio, sfcevp +! averaged accumulated snow, acsnow +! snow melt,acsnom +! humidity at roughness length, qz0 +! u at roughness length, uz0 +! v at roughness length, vz0 +! shelter rh max, maxrhshltr +! shelter rh min, minrhshltr +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) + do j=jsta_2l,jend_2u + do i=1,im + smstav(i,j) = spval + sfcevp(i,j) = spval + acsnow(i,j) = spval + acsnom(i,j) = spval + qz0(i,j) = spval + uz0(i,j) = spval + vz0(i,j) = spval + maxrhshltr(i,j) = SPVAL + minrhshltr(i,j) = SPVAL + enddo + enddo + +! GFS does not have mixing length,el_pbl +! exchange coefficient, exch_h + do l=1,lm +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) + do j=jsta_2l,jend_2u + do i=1,im + el_pbl(i,j,l) = spval + exch_h(i,j,l) = spval + enddo + enddo + enddo + +! GFS does not have deep convective cloud top and bottom fields +!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & +!$omp& shared(htopd,hbotd,htops,hbots,cuppt) + do j=jsta_2l,jend_2u + do i=1,im + htopd(i,j) = SPVAL + hbotd(i,j) = SPVAL + htops(i,j) = SPVAL + hbots(i,j) = SPVAL + cuppt(i,j) = SPVAL + enddo + enddo +! +! get inital date + sdat(1) = wrt_int_state%idate(2) !month + sdat(2) = wrt_int_state%idate(3) !day + sdat(3) = wrt_int_state%idate(1) !year + ihrst = wrt_int_state%idate(4) !hour + + idat(1) = wrt_int_state%fdate(2) + idat(2) = wrt_int_state%fdate(3) + idat(3) = wrt_int_state%fdate(1) + idat(4) = wrt_int_state%fdate(4) + idat(5) = wrt_int_state%fdate(5) +! + if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst +! CALL W3DIFDAT(JDATE,IDATE,0,RINC) +! +! if(mype==0)print *,' rinc=',rinc +! ifhr = nint(rinc(2)+rinc(1)*24.) +! if(mype==0)print *,' ifhr=',ifhr +! ifmin = nint(rinc(3)) +! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop +! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin +! + tstart = 0. +! +!** initialize cloud water and ice mixing ratio +!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & +!$omp& shared(qqw,qqr,qqs,qqi) + do l = 1,lm + do j = jsta, jend + do i = 1,im + qqw(i,j,l) = 0. + qqr(i,j,l) = 0. + qqs(i,j,l) = 0. + qqi(i,j,l) = 0. + enddo + enddo + enddo +! +!----------------------------------------------------------------------------- +! get post fields +!----------------------------------------------------------------------------- +! + foundland = .false. + foundice = .false. + get_lsmsk: do ibdl=1, wrt_int_state%FBCount + +! find lans sea mask + found = .false. + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out +! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found + if (found) then + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + ista = lbound(arrayr42d,1) + iend = ubound(arrayr42d,1) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + do j=jsta, jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) + enddo + enddo + foundland = .true. + endif + +! find ice fraction + found = .false. + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out +! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found + if (found) then + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + ista = lbound(arrayr42d,1) + iend = ubound(arrayr42d,1) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + do j=jsta, jend + do i=ista, iend + sice(i,j) = arrayr42d(i,j) + if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 + enddo + enddo + foundice = .true. + endif + + enddo get_lsmsk + if (.not.foundland .or. .not.foundice) then + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + endif + if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount +! + file_loop_all: do ibdl=1, wrt_int_state%FBCount +! +! get grid dimension count +! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & +! ista,iend,'jdim=',jsta,jend + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + +! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) + allocate(fcstField(ncount_field)) + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + +! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field +! + call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + if (index(trim(fieldname),"vector") >0) cycle +! +!** for 2D fields + if (fieldDimCount == 2) then + + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + allocate( arrayr42d(ista:iend,jsta:jend)) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + do j=jsta, jend + do i=ista, iend + arrayr42d(i,j) = arrayr82d(i,j) + enddo + enddo + endif + + ! Terrain height (*G later) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + do j=jsta,jend + do i=ista, iend + fis(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! Surface pressure +! if(trim(fieldname)=='pressfc') then +! !$omp parallel do private(i,j) +! do j=jsta,jend +! do i=ista, iend +! pint(i,j)=arrayr42d(i,j) +! enddo +! enddo +! endif + + ! PBL height using nemsio + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + do j=jsta,jend + do i=ista, iend + pblh(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! frictional velocity + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + do j=jsta,jend + do i=ista, iend + ustar(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! roughness length + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + do j=jsta,jend + do i=ista, iend + z0(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! sfc exchange coeff + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcexc(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! aerodynamic conductance + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + do j=jsta,jend + do i=ista, iend + acond(i,j)=arrayr42d(i,j) + enddo + enddo + endif + + ! surface potential T + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + ths(i,j) = arrayr42d(i,j) + endif + enddo + enddo + endif + + ! convective precip in m per physics time step + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) & + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + enddo + enddo + endif + + ! continuous bucket convective precip in m per physics time step + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + endif + enddo + enddo + endif + + ! time averaged bucketed precip rate + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + endif + enddo + enddo + endif + + ! time averaged continuous precip rate in m per physics time step + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + endif + enddo + enddo + endif + + ! precip rate in m per physics time step + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + endif + enddo + enddo + endif + + ! convective precip rate in m per physics time step + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + endif + enddo + enddo + endif + + ! inst snow water eqivalent + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + sno(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + enddo + enddo + endif + + ! ave snow cover + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + snoavg(i,j) = arrayr42d(i,j) + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. + enddo + enddo + endif + + ! snow depth in mm + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + si(i,j) = arrayr42d(i,j) + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 + enddo + enddo + endif + + ! 2m potential T (computed later) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + tshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! surface potential T + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + qshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! mid day avg albedo in fraction + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgalbedo(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgalbedo(i,j) = avgalbedo(i,j) * 0.01 + endif + enddo + enddo + endif + + ! time averaged column cloud fraction + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgtcdc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgtcdc(i,j) = avgtcdc(i,j) * 0.01 + endif + enddo + enddo + endif + + ! maximum snow albedo in fraction + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + do j=jsta,jend + do i=ista, iend + mxsnal(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + mxsnal(i,j) = mxsnal(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave high cloud fraction + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfrach(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfrach(i,j) = avgcfrach(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave low cloud fraction + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfracl(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfracl(i,j) = avgcfracl(i,j) * 0.01 + endif + enddo + enddo + endif + + ! ave middle cloud fraction + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + do j=jsta,jend + do i=ista, iend + avgcfracm(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + avgcfracm(i,j) = avgcfracm(i,j) * 0.01 + endif + enddo + enddo + endif + + ! inst convective cloud fraction + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + do j=jsta,jend + do i=ista, iend + cnvcfr(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + cnvcfr(i,j) = cnvcfr(i,j) * 0.01 + endif + enddo + enddo + endif + + ! slope type + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + islope(i,j) = nint(arrayr42d(i,j)) + else + islope(i,j) = 0 + endif + enddo + enddo + endif + + ! time averaged column cloud fraction + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + cmc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 + if (sm(i,j) /= 0.0) cmc(i,j) = spval + enddo + enddo + endif + + ! frozen precip fraction + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) /= spval) then + !set range within (0,1) + sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) + else + sr(i,j) = spval + endif + enddo + enddo + endif + + ! sea ice skin temperature + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + do j=jsta,jend + do i=ista,iend + if (arrayr42d(i,j) /= spval) then + ti(i,j) = arrayr42d(i,j) + if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval + else + ti(i,j) = spval + endif + enddo + enddo + endif + + ! vegetation fraction + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + vegfrc(i,j) = arrayr42d(i,j) + if (arrayr42d(i,j) /= spval) then + vegfrc(i,j) = vegfrc(i,j) * 0.01 + else + vegfrc(i,j) = 0.0 + endif + if (sm(i,j) /= 0.0) vegfrc(i,j) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,1) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,2) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,3) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval + enddo + enddo + endif + + ! liquid volumetric soil mpisture in fraction + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + sh2o(i,j,4) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,1) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,1) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,2) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,2) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,3) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,3) = spval + enddo + enddo + endif + + ! volumetric soil moisture + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smc(i,j,4) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smc(i,j,4) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,1) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,2) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,3) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval + enddo + enddo + endif + + ! soil temperature + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + stc(i,j,4) = arrayr42d(i,j) + !mask open water areas, combine with sea ice tmp + if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval + enddo + enddo + endif + + ! time averaged incoming sfc longwave + if(trim(fieldname)=='dlwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! inst incoming sfc longwave + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + do j=jsta,jend + do i=ista, iend + rlwin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwout(i,j) = arrayr42d(i,j) + if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) + enddo + enddo + endif + + ! inst outgoing sfc longwave + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + do j=jsta,jend + do i=ista, iend + radot(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing model top longwave + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwtoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc shortwave + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! inst incoming sfc shortwave + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + rswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc uv-b + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + do j=jsta,jend + do i=ista, iend + auvbin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged incoming sfc clear sky uv-b + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + auvbinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswout(i,j) = arrayr42d(i,j) + if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) + enddo + enddo + endif + + ! inst outgoing sfc shortwave + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + do j=jsta,jend + do i=ista, iend + rswout(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged model top incoming shortwave + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswintoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! ime averaged model top outgoing shortwave + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswtoa(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface sensible heat flux, multiplied by -1 because + ! wrf model fluxhas reversed sign convention using gfsio + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcshx(i,j) = arrayr42d(i,j) + if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) + enddo + enddo + endif + + ! inst surface sensible heat flux + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + do j=jsta,jend + do i=ista, iend + twbs(i,j) = arrayr42d(i,j) + if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) + enddo + enddo + endif + + ! time averaged surface latent heat flux, multiplied by -1 because + ! wrf model flux has reversed sign vonvention using gfsio + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfclhx(i,j) = arrayr42d(i,j) + if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) + enddo + enddo + endif + + ! inst surface latent heat flux + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + do j=jsta,jend + do i=ista, iend + qwbs(i,j) = arrayr42d(i,j) + if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) + enddo + enddo + endif + + ! time averaged ground heat flux + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + subshx(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + enddo + enddo + endif + + ! inst ground heat flux + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + grnflx(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + enddo + enddo + endif + + ! time averaged zonal momentum flux + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcux(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged meridional momentum flux + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + do j=jsta,jend + do i=ista, iend + sfcvx(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged zonal gravity wave stress + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + do j=jsta,jend + do i=ista, iend + gtaux(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged meridional gravity wave stress + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + do j=jsta,jend + do i=ista, iend + gtauy(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged accumulated potential evaporation + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + avgpotevp(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + enddo + enddo + endif + + ! inst potential evaporation + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + potevp(i,j) = arrayr42d(i,j) + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + enddo + enddo + endif + + ! 10 m u + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + do j=jsta,jend + do i=ista, iend + u10(i,j) = arrayr42d(i,j) + u10h(i,j) = u10(i,j) + enddo + enddo + endif + + ! 10 m v + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + do j=jsta,jend + do i=ista, iend + v10(i,j) = arrayr42d(i,j) + v10h(i,j) = v10(i,j) + enddo + enddo + endif + + ! vegetation type + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + ivgtyp(i,j) = nint(arrayr42d(i,j)) + else + ivgtyp(i,j) = 0 + endif + enddo + enddo + endif + + ! soil type + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + do j=jsta,jend + do i=ista, iend + if (arrayr42d(i,j) < spval) then + isltyp(i,j) = nint(arrayr42d(i,j)) + else + isltyp(i,j) = 0 + endif + enddo + enddo + endif + + ! inst cloud top pressure + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptop(i,j) = arrayr42d(i,j) + if(ptop(i,j) <= 0.0) ptop(i,j) = spval + enddo + enddo + endif + + ! inst cloud bottom pressure + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbot(i,j) = arrayr42d(i,j) + if(pbot(i,j) <= 0.0) pbot(i,j) = spval + enddo + enddo + endif + + ! time averaged low cloud top pressure + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptopl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged low cloud bottom pressure + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbotl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged low cloud top temperature + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttopl(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud top pressure + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptopm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud bottom pressure + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + do j=jsta,jend + do i=ista, iend + pbotm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged middle cloud top temperature + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttopm(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud top pressure + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + do j=jsta,jend + do i=ista, iend + ptoph(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud bottom pressure + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + do j=jsta,jend + do i=ista, iend + pboth(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged high cloud top temperature + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + do j=jsta,jend + do i=ista, iend + ttoph(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged boundary layer cloud cover + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + do j=jsta,jend + do i=ista, iend + pblcfr(i,j) = arrayr42d(i,j) + if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 + enddo + enddo + endif + + ! cloud work function + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + do j=jsta,jend + do i=ista, iend + cldwork(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! water runoff + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + runoff(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) runoff(i,j) = spval + enddo + enddo + endif + + ! shelter max temperature + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + maxtshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter min temperature + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + mintshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! ice thickness + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + do j=jsta,jend + do i=ista, iend + dzice(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! wilting point + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smcwlt(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smcwlt(i,j) = spval + enddo + enddo + endif + + ! sunshine duration + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + do j=jsta,jend + do i=ista, iend + suntime(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! field capacity + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + fieldcapa(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval + enddo + enddo + endif + + ! time averaged surface visible beam downward solar flux + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + avisbeamswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface visible diffuse downward solar flux + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + avisdiffswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface near IR beam downward solar flux + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + airbeamswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface near IR diffuse downward solar flux + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + do j=jsta,jend + do i=ista, iend + airdiffswin(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky outgoing LW + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwoutc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged TOA clear sky outgoing LW + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwtoac(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky outgoing SW + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswoutc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged TOA clear sky outgoing SW + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswtoac(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky incoming LW + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + alwinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! time averaged surface clear sky incoming SW + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + do j=jsta,jend + do i=ista, iend + aswinc(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter max specific humidity + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + maxqshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! shelter min temperature + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + do j=jsta,jend + do i=ista, iend + minqshltr(i,j) = arrayr42d(i,j) + enddo + enddo + endif + + ! storm runoffs + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + ssroff(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) ssroff(i,j) = spval + enddo + enddo + endif + + ! direct soil evaporation + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgedir(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgedir(i,j) = spval + enddo + enddo + endif + + ! canopy water evap + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgecan(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgecan(i,j) = spval + enddo + enddo + endif + + ! plant transpiration + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + avgetrans(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) avgetrans(i,j) = spval + enddo + enddo + endif + + ! snow sublimation + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + do j=jsta,jend + do i=ista, iend + avgesnow(i,j) = arrayr42d(i,j) + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + enddo + enddo + endif + + ! total soil moisture + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + smstot(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) smstot(i,j) = spval + enddo + enddo + endif + + ! snow phase change heat flux + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + do j=jsta,jend + do i=ista, iend + snopcx(i,j) = arrayr42d(i,j) + if (sm(i,j) /= 0.0) snopcx(i,j) = spval + enddo + enddo + endif + +! else if (fieldDimCount > gridDimCount) then + else if (fieldDimCount ==3) then + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) + arrayr43d = 0. + do k=kstart,kend + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + do j=jsta,jend + do i=ista,iend + arrayr43d(i,j,k) = arrayr83d(i,j,k) + enddo + enddo + enddo + endif + + ! model level T + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + t(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + + !! sig4 + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + do j=jsta,jend + do i=ista, iend + tlmh = t(i,j,lm) * t(i,j,lm) + sigt4(i,j) = 5.67E-8 * tlmh * tlmh + enddo + enddo + endif + + ! model level spfh + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + q(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level u wind + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + uh(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level v wind + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + vh(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level pressure thinkness + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + dpres(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level gh thinkness, model output negative delz + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + zint(i,j,l)=-1.*arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level w + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + wh(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ozone mixing ratio + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + o3(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + +! for GFDL MP + if (imp_physics == 11) then + ! model level cloud water mixing ratio + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqw(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqi(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqr(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqs(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqg(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif +!gfdlmp + endif + + ! model level cloud amount + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + cfr(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ref3d + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + ref_10cm(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo +! print *,'in gfs_post, get ref_10cm=',maxval(ref_10cm), minval(ref_10cm) + endif + + ! model level ref3d + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + q2(i,j,l)=arrayr43d(i,j,l) + enddo + enddo + enddo + endif +!3d fields + endif + +! end loop ncount_field + enddo + + if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & + setvar_atmfile = .true. + if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) & + setvar_sfcfile = .true. + deallocate(fcstField) + +! end file_loop_all + enddo file_loop_all + +! recompute full layer of zint +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) + do j=jsta,jend + do i=1,im + if (fis(i,j) /= spval) then + zint(i,j,lp1) = fis(i,j) + fis(i,j) = fis(i,j) * grav + endif + enddo + enddo + + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) + do j=jsta,jend + do i=1,im + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) + enddo + enddo + enddo + +! compute pint from top down +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) + do j=jsta,jend + do i=1,im + pint(i,j,1) = ak5(1) + end do + end do + + do l=2,lp1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + do j=jsta,jend + do i=1,im + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + +!compute pmid from averaged two layer pint + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + enddo + enddo + enddo + +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do +! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) + +! compute alpint + do l=lp1,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) + do j=jsta,jend + do i=1,im + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do + +! compute zmid + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + do j=jsta,jend + do i=1,im + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do +! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & +! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & +! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & +! 'pmid=',maxval(pmid(1:im,jsta:jend,1)),minval(pmid(1:im,jsta:jend,1)), & +! 'alpint=',maxval(alpint(1:im,jsta:jend,2)),minval(alpint(1:im,jsta:jend,2)) +! print *,'in post_gfs,alpint=',maxval(alpint(1:im,jsta:jend,1)), & +! minval(alpint(1:im,jsta:jend,1)) + +! surface potential T, and potential T at roughness length +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,lp1,sm,ths,sst,thz0,pint) + do j=jsta,jend + do i=ista, iend + !assign sst + if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then + sst(i,j) = ths(i,j) + else + sst(i,j) = spval + endif + if (ths(i,j) /= spval) then + ths(i,j) = ths(i,j)* (p1000/pint(i,j,lp1))**capa + thz0(i,j) = ths(i,j) + endif + enddo + enddo + +! compute cwm for gfdlmp + if( imp_physics == 11 ) then + do l=1,lm +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) + do j=jsta,jend + do i=ista,iend + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + enddo + enddo + enddo + endif + +! estimate 2m pres and convert t2m to theta +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) + do j=jsta,jend + do i=ista, iend + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + enddo + enddo + +!htop + do j=jsta,jend + do i=1,im + htop(i,j) = spval + if(ptop(i,j) < spval)then + do l=1,lm + if(ptop(i,j) <= pmid(i,j,l))then + htop(i,j)=l + exit + end if + end do + end if + end do + end do + +! hbot + do j=jsta,jend + do i=1,im + if(pbot(i,j) < spval)then + do l=lm,1,-1 + if(pbot(i,j) >= pmid(i,j,l)) then + hbot(i,j) = l + exit + end if + end do + end if + end do + end do + +! generate look up table for lifted parcel calculations + thl = 210. + plq = 70000. + pt_tbl = 10000. ! this is for 100 hPa added by Moorthi + + call table(ptbl,ttbl,pt_tbl, & + rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0) + + call tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q) + + if(mype == 0)then + write(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' + write(6,51) (SPL(L),L=1,LSM) + 50 format(14(F4.1,1X)) + 51 format(8(F8.1,1X)) + endif +! +!$omp parallel do default(none) private(l) shared(lsm,alsl,spl) + do l = 1,lsm + alsl(l) = log(spl(l)) + end do +! +! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) +!!! above is fv3 change +! +!more fields need to be computed +! + end subroutine set_postvars_gfs + + + end module post_gfs From 34b22022875ef402bb0ccf4d26dd30ab52f3e9c5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Dec 2020 10:20:47 -0500 Subject: [PATCH 113/217] minor update to FV3GFS_io and ipd physics driver to be consistent with ccpp --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 17 +++++++++++++++-- io/FV3GFS_io.F90 | 4 ++-- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 217b91ae0..5a8362705 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 217b91ae0c7e05265c731ff4769cfa2d4efb0bc5 +Subproject commit 5a8362705303dbcf6b29bd9f0cfc0ba99861a885 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 1d492307f..ce67c175a 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -1179,6 +1179,14 @@ subroutine GFS_physics_driver & if (fice(i) >= Model%min_seaice) then icy(i) = .true. Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) + if (Model%cplflx) then + islmsk_cice(i) = 4 + flag_cice(i) = .true. + else + islmsk_cice(i) = 2 + flag_cice(i) = .false. + endif + islmsk(i) = 2 else fice(i) = zero zice(i) = zero @@ -1194,11 +1202,14 @@ subroutine GFS_physics_driver & if (fice(i) >= Model%min_lakeice) then icy(i) = .true. Sfcprop%tisfc(i) = max(timin, min(Sfcprop%tisfc(i), tgice)) + islmsk(i) = 2 else fice(i) = zero zice(i) = zero islmsk(i) = 0 endif + islmsk_cice(i) = islmsk(i) + flag_cice(i) = .false. if (fice(i) < one) then wet(i) = .true. ! some open lake if (icy(i)) Sfcprop%tsfco(i) = max(Sfcprop%tisfc(i), tgice) @@ -1264,7 +1275,8 @@ subroutine GFS_physics_driver & ! snowd3(i,3) = Sfcprop%snowd(i) snowd3(i,3) = zero weasd3(i,3) = zero - semis3(i,3) = 0.984_kind_phys + semis3(i,3) = 0.97_kind_phys +! semis3(i,3) = 0.984_kind_phys endif ! if (dry(i)) then ! Land @@ -1287,7 +1299,8 @@ subroutine GFS_physics_driver & ! snowd3(i,2) = Sfcprop%snowd(i) / fice(i) ep1d3(i,2) = zero gflx3(i,2) = zero - semis3(i,2) = 0.95_kind_phys + semis3(i,2) = 0.96_kind_phys +! semis3(i,2) = 0.95_kind_phys endif if (nint(Sfcprop%slmsk(i)) /= 1) Sfcprop%slmsk(i) = islmsk(i) enddo diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 229066500..f08ecc6dd 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1134,7 +1134,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) endif else ! not a fractional grid if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) +! Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%landfrac(ix) = zero @@ -1150,7 +1150,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain) Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2 + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif else if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then From 27dacbcf8433d561a715fcdfc7100b8d44ee5a29 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 22 Dec 2020 19:49:54 -0500 Subject: [PATCH 114/217] after updating ccpp for nsst error in tranferring code from IPD - error noticed by Xu Li --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 44a3c5c20..340ee5c3e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 44a3c5c20a8d775d3c28e5b72c8aff27d2329fc6 +Subproject commit 340ee5c3e5f31faedeb833d52ae3ae992115fc4d From c6039db84099a24c6aa72feff7a34c71626ef0db Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 5 Jan 2021 18:58:42 +0000 Subject: [PATCH 115/217] after submodule sync --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 211d8da10..bfb7558ab 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 211d8da10b367408f197e04716097c057100bf02 +Subproject commit bfb7558ab3e3398f8bae58bb94525cd7349af8ab From b1629932f6bbe5c927e55d8499090876cec84d65 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 6 Jan 2021 09:50:51 -0500 Subject: [PATCH 116/217] reverting th unit for showd --- gfsphysics/GFS_layer/GFS_diagnostics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gfsphysics/GFS_layer/GFS_diagnostics.F90 b/gfsphysics/GFS_layer/GFS_diagnostics.F90 index e02d48fdd..a289df88a 100644 --- a/gfsphysics/GFS_layer/GFS_diagnostics.F90 +++ b/gfsphysics/GFS_layer/GFS_diagnostics.F90 @@ -3018,7 +3018,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'snowd' ExtDiag(idx)%desc = 'surface snow depth' - ExtDiag(idx)%unit = 'mm' + ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%cnvfac = cn_one/cn_th allocate (ExtDiag(idx)%data(nblks)) From ae60021459151dc84d29945e3e9cdb22fd0771fd Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 21 Jan 2021 01:14:42 +0000 Subject: [PATCH 117/217] removing some blanksin GFS_typedefs.F90 --- ccpp/data/GFS_typedefs.F90 | 116 ++++++++++++++++++------------------- 1 file changed, 58 insertions(+), 58 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 83c4553bd..3833627da 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -182,7 +182,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smc (:,:) => null() !< soil moisture content real (kind=kind_phys), pointer :: stc (:,:) => null() !< soil temperature content real (kind=kind_phys), pointer :: slc (:,:) => null() !< soil liquid water content - + contains procedure :: create => statein_create !< allocate array data end type GFS_statein_type @@ -439,7 +439,7 @@ module GFS_typedefs !--- outgoing accumulated quantities real (kind=kind_phys), pointer :: rain_cpl (:) => null() !< total rain precipitation real (kind=kind_phys), pointer :: rainc_cpl (:) => null() !< convective rain precipitation - real (kind=kind_phys), pointer :: snow_cpl (:) => null() !< total snow precipitation + real (kind=kind_phys), pointer :: snow_cpl (:) => null() !< total snow precipitation real (kind=kind_phys), pointer :: dusfc_cpl (:) => null() !< sfc u momentum flux real (kind=kind_phys), pointer :: dvsfc_cpl (:) => null() !< sfc v momentum flux real (kind=kind_phys), pointer :: dtsfc_cpl (:) => null() !< sfc sensible heat flux @@ -488,7 +488,7 @@ module GFS_typedefs !--- cellular automata real (kind=kind_phys), pointer :: ca1 (:) => null() ! real (kind=kind_phys), pointer :: ca2 (:) => null() ! - real (kind=kind_phys), pointer :: ca3 (:) => null() ! + real (kind=kind_phys), pointer :: ca3 (:) => null() ! real (kind=kind_phys), pointer :: ca_deep (:) => null() ! real (kind=kind_phys), pointer :: ca_turb (:) => null() ! real (kind=kind_phys), pointer :: ca_shal (:) => null() ! @@ -636,7 +636,7 @@ module GFS_typedefs !< available; use latest; do extrapolation. !< ictm=yyyy0 => use yyyy data for the forecast time; !< no extrapolation. - !< ictm=yyyy1 = > use yyyy data for the fcst. If needed, + !< ictm=yyyy1 = > use yyyy data for the fcst. If needed, !< do extrapolation to match the fcst time. !< ictm=-1 => use user provided external data for !< the fcst time; no extrapolation. @@ -651,9 +651,9 @@ module GFS_typedefs !< =0 => Use constant decorrelation length, decorr_con !< =1 => Use spatially varying decorrelation length (Hogan et al. 2010) !< =2 => Use spatially and temporally varyint decorrelation length (Oreopoulos et al. 2012) - real(kind_phys) :: dcorr_con !< Decorrelation length constant (km) (if idcor = 0) + real(kind_phys) :: dcorr_con !< Decorrelation length constant (km) (if idcor = 0) logical :: crick_proof !< CRICK-Proof cloud water - logical :: ccnorm !< Cloud condensate normalized by cloud cover + logical :: ccnorm !< Cloud condensate normalized by cloud cover logical :: norad_precip !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr !< flag to output sw heating rate (Radtend%swhc) @@ -711,7 +711,7 @@ module GFS_typedefs integer :: fprcp !< no prognostic rain and snow (MG) integer :: pdfflag !< pdf flag for MG macrophysics real(kind=kind_phys) :: mg_dcs !< Morrison-Gettelman microphysics parameters - real(kind=kind_phys) :: mg_qcvar + real(kind=kind_phys) :: mg_qcvar real(kind=kind_phys) :: mg_ts_auto_ice(2) !< ice auto conversion time scale real(kind=kind_phys) :: mg_rhmini !< relative humidity threshold parameter for nucleating ice @@ -811,7 +811,7 @@ module GFS_typedefs logical :: pert_cd !< flag for perturbing the surface drag coefficient for momentum in surface layer scheme (1 = True) integer :: ntsflg !< flag for updating skin temperature in the GFDL surface layer scheme real(kind=kind_phys) :: sfenth !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s - + !--- flake model parameters integer :: lkm !< flag for flake model @@ -998,7 +998,7 @@ module GFS_typedefs !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid !< flag for fractional grid - logical :: ignore_lake !< flag for ignoring lakes + 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 @@ -1035,7 +1035,7 @@ module GFS_typedefs integer :: ncells_g !< cellular automata finer grid real(kind=kind_phys) :: nfracseed !< cellular automata seed probability integer :: nseed !< cellular automata seed frequency - integer :: nseed_g !< cellular automata seed frequency + integer :: nseed_g !< cellular automata seed frequency logical :: do_ca !< cellular automata main switch logical :: ca_sgs !< switch for sgs ca logical :: ca_global !< switch for global ca @@ -1058,10 +1058,10 @@ module GFS_typedefs integer :: lndp_type integer :: n_var_lndp character(len=3) :: lndp_var_list(6) ! dimension here must match n_var_max_lndp in stochy_nml_def - real(kind=kind_phys) :: lndp_prt_list(6) ! dimension here must match n_var_max_lndp in stochy_nml_def - ! also previous code had dimension 5 for each pert, to allow - ! multiple patterns. It wasn't fully coded (and wouldn't have worked - ! with nlndp>1, so I just dropped it). If we want to code it properly, + real(kind=kind_phys) :: lndp_prt_list(6) ! dimension here must match n_var_max_lndp in stochy_nml_def + ! also previous code had dimension 5 for each pert, to allow + ! multiple patterns. It wasn't fully coded (and wouldn't have worked + ! with nlndp>1, so I just dropped it). If we want to code it properly, ! we'd need to make this dim(6,5). !--- tracer handling character(len=32), pointer :: tracer_names(:) !< array of initialized tracers from dynamic core @@ -2131,7 +2131,7 @@ module GFS_typedefs !------------------------ ! GFS_statein_type%create !------------------------ - subroutine statein_create (Statein, IM, Model) + subroutine statein_create (Statein, IM, Model) implicit none class(GFS_statein_type) :: Statein @@ -2476,7 +2476,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%tsnoxy = clear_val Sfcprop%smoiseq = clear_val Sfcprop%zsnsoxy = clear_val - + allocate(Sfcprop%draincprv (IM)) allocate(Sfcprop%drainncprv (IM)) allocate(Sfcprop%diceprv (IM)) @@ -2488,7 +2488,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%diceprv = clear_val Sfcprop%dsnowprv = clear_val Sfcprop%dgraupelprv = clear_val - + endif ! HWRF NOAH LSM allocate and init when used @@ -2497,7 +2497,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%snotime(IM)) Sfcprop%snotime = clear_val end if - + if (Model%do_myjsfc.or.Model%do_myjpbl.or.(Model%lsm == Model%lsm_noah_wrfv4)) then allocate(Sfcprop%z0base(IM)) Sfcprop%z0base = clear_val @@ -2770,7 +2770,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%ca_turb = clear_val Coupling%ca_shal = clear_val Coupling%ca_rad = clear_val - Coupling%ca_micro = clear_val + Coupling%ca_micro = clear_val Coupling%condition = clear_val endif @@ -2960,7 +2960,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< =2 => Use spatially and temporally varyint decorrelation length (Oreopoulos et al. 2012) real(kind_phys) :: dcorr_con = 2.5 !< Decorrelation length constant (km) (if idcor = 0) logical :: crick_proof = .false. !< CRICK-Proof cloud water - logical :: ccnorm = .false. !< Cloud condensate normalized by cloud cover + logical :: ccnorm = .false. !< Cloud condensate normalized by cloud cover logical :: norad_precip = .false. !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr = .true. !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr = .true. !< flag to output sw heating rate (Radtend%swhc) @@ -2982,7 +2982,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: doGP_cldoptics_LUT = .false. !< Use RRTMGP cloud-optics: LUTs? integer :: rrtmgp_nrghice = 0 !< Number of ice-roughness categories integer :: rrtmgp_nGauss_ang = 1 !< Number of angles used in Gaussian quadrature - logical :: do_GPsw_Glw = .false. + logical :: do_GPsw_Glw = .false. logical :: use_LW_jacobian = .false. !< Use Jacobian of LW to update LW radiation tendencies. logical :: doGP_lwscat = .false. !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics !--- Z-C microphysical parameters @@ -3333,8 +3333,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: do_shum = .false. logical :: do_skeb = .false. integer :: skeb_npass = 11 - integer :: lndp_type = 0 - integer :: n_var_lndp = 0 + integer :: lndp_type = 0 + integer :: n_var_lndp = 0 !--- aerosol scavenging factors character(len=20) :: fscav_aero(20) = 'default' @@ -3433,7 +3433,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & nca, ncells, nlives, nca_g, ncells_g, nlives_g, nfracseed, & nseed, nseed_g, nthresh, do_ca, & ca_sgs, ca_global,iseed_ca,ca_smooth, & - nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, & + nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, & !--- IAU iau_delthrs,iaufhrs,iau_inc_files,iau_filter_increments, & iau_drymassfixer, & @@ -3445,7 +3445,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- aerosol scavenging factors ('name:value' string array) fscav_aero -!--- other parameters +!--- other parameters integer :: nctp = 0 !< number of cloud types in CS scheme logical :: gen_coord_hybrid = .false. !< for Henry's gen coord @@ -4554,12 +4554,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & stop end if if (Model%me == Model%master) print *,' Using Thompson double moment microphysics', & - ' ltaerosol = ',Model%ltaerosol, & - ' ttendlim =',Model%ttendlim, & - ' effr_in =',Model%effr_in, & - ' lradar =',Model%lradar, & - ' nsradar_reset =',Model%nsradar_reset, & - ' num_p3d =',Model%num_p3d, & + ' ltaerosol = ',Model%ltaerosol, & + ' ttendlim =',Model%ttendlim, & + ' effr_in =',Model%effr_in, & + ' lradar =',Model%lradar, & + ' nsradar_reset =',Model%nsradar_reset, & + ' num_p3d =',Model%num_p3d, & ' num_p2d =',Model%num_p2d else if (Model%imp_physics == Model%imp_physics_mg) then ! Morrison-Gettelman Microphysics @@ -4581,7 +4581,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ncnd = 5 endif Model%num_p3d = 6 - Model%ngeffr = 6 + Model%ngeffr = 6 endif if (Model%me == Model%master) & print *,' Using Morrison-Gettelman double moment microphysics', & @@ -4602,11 +4602,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%npdf3d = 0 if(Model%effr_in) then Model%num_p3d = 5 - Model%nleffr = 1 - Model%nieffr = 2 - Model%nreffr = 3 - Model%nseffr = 4 - Model%ngeffr = 5 + Model%nleffr = 1 + Model%nieffr = 2 + Model%nreffr = 3 + Model%nseffr = 4 + Model%ngeffr = 5 else Model%num_p3d = 1 ! Effective radii not used, point to valid index in dummy phy_f3d array @@ -5353,18 +5353,18 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%phy_myj_a1t (IM)) allocate (Tbd%phy_myj_a1q (IM)) !print*,"Allocating all MYJ schemes variables:" - Tbd%phy_myj_qsfc = clear_val - Tbd%phy_myj_thz0 = clear_val - Tbd%phy_myj_qz0 = clear_val - Tbd%phy_myj_uz0 = clear_val - Tbd%phy_myj_vz0 = clear_val - Tbd%phy_myj_akhs = clear_val - Tbd%phy_myj_akms = clear_val - Tbd%phy_myj_chkqlm = clear_val - Tbd%phy_myj_elflx = clear_val - Tbd%phy_myj_a1u = clear_val - Tbd%phy_myj_a1t = clear_val - Tbd%phy_myj_a1q = clear_val + Tbd%phy_myj_qsfc = clear_val + Tbd%phy_myj_thz0 = clear_val + Tbd%phy_myj_qz0 = clear_val + Tbd%phy_myj_uz0 = clear_val + Tbd%phy_myj_vz0 = clear_val + Tbd%phy_myj_akhs = clear_val + Tbd%phy_myj_akms = clear_val + Tbd%phy_myj_chkqlm = clear_val + Tbd%phy_myj_elflx = clear_val + Tbd%phy_myj_a1u = clear_val + Tbd%phy_myj_a1t = clear_val + Tbd%phy_myj_a1q = clear_val end if end subroutine tbd_create @@ -5382,7 +5382,7 @@ subroutine cldprop_create (Cldprop, IM, Model) type(GFS_control_type), intent(in) :: Model allocate (Cldprop%cv (IM)) - allocate (Cldprop%cvt (IM)) + allocate (Cldprop%cvt (IM)) allocate (Cldprop%cvb (IM)) Cldprop%cv = clear_val @@ -5396,9 +5396,9 @@ end subroutine cldprop_create ! GFS_radtend_type%create !****************************************** subroutine radtend_create (Radtend, IM, Model) - + implicit none - + class(GFS_radtend_type) :: Radtend integer, intent(in) :: IM type(GFS_control_type), intent(in) :: Model @@ -5415,7 +5415,7 @@ subroutine radtend_create (Radtend, IM, Model) Radtend%sfcflw%upfx0 = clear_val Radtend%sfcflw%dnfxc = clear_val Radtend%sfcflw%dnfx0 = clear_val - + allocate (Radtend%htrsw (IM,Model%levs)) allocate (Radtend%htrlw (IM,Model%levs)) allocate (Radtend%sfalb (IM)) @@ -5429,12 +5429,12 @@ subroutine radtend_create (Radtend, IM, Model) Radtend%coszen = clear_val Radtend%tsflw = clear_val Radtend%semis = clear_val - + !--- In/Out (???) (radiation only) allocate (Radtend%coszdg (IM)) Radtend%coszdg = clear_val - + !--- In/Out (???) (physics only) allocate (Radtend%swhc (IM,Model%levs)) allocate (Radtend%lwhc (IM,Model%levs)) @@ -6374,7 +6374,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%fluxswUP_allsky (IM, Model%levs+1)) allocate (Interstitial%fluxswDOWN_allsky (IM, Model%levs+1)) allocate (Interstitial%fluxswUP_clrsky (IM, Model%levs+1)) - allocate (Interstitial%fluxswDOWN_clrsky (IM, Model%levs+1)) + allocate (Interstitial%fluxswDOWN_clrsky (IM, Model%levs+1)) allocate (Interstitial%aerosolslw (IM, Model%levs, Model%rrtmgp_nBandsLW, NF_AELW)) allocate (Interstitial%aerosolssw (IM, Model%levs, Model%rrtmgp_nBandsSW, NF_AESW)) allocate (Interstitial%cld_frac (IM, Model%levs)) @@ -6388,7 +6388,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%cld_rerain (IM, Model%levs)) allocate (Interstitial%precip_frac (IM, Model%levs)) allocate (Interstitial%icseed_lw (IM)) - allocate (Interstitial%icseed_sw (IM)) + allocate (Interstitial%icseed_sw (IM)) allocate (Interstitial%flxprf_lw (IM, Model%levs+1)) allocate (Interstitial%flxprf_sw (IM, Model%levs+1)) allocate (Interstitial%sfc_emiss_byband (Model%rrtmgp_nBandsLW,IM)) @@ -6771,7 +6771,7 @@ subroutine interstitial_rad_reset (Interstitial, Model) Interstitial%precip_overlap_param = clear_val Interstitial%fluxlwDOWN_allsky = clear_val Interstitial%fluxlwUP_clrsky = clear_val - Interstitial%fluxlwDOWN_clrsky = clear_val + Interstitial%fluxlwDOWN_clrsky = clear_val Interstitial%fluxswUP_allsky = clear_val Interstitial%fluxswDOWN_allsky = clear_val Interstitial%fluxswUP_clrsky = clear_val From a6c09c3daa7252f46cd66fb789916b06b09199d7 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 30 Jan 2021 20:53:01 -0500 Subject: [PATCH 118/217] make sure the f00 surface file contains ice from gfs initial state --- atmos_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 3730da692..aec14cff6 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1626,7 +1626,7 @@ subroutine assign_importdata(rc) ! get sea ice surface temperature !-------------------------------- fldname = 'sea_ice_surface_temperature' - if (trim(impfield_name) == trim(fldname)) then + if (trim(impfield_name) == trim(fldname) .and. GFS_control%kdt > 1) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) @@ -1667,7 +1667,7 @@ subroutine assign_importdata(rc) ! get sea ice fraction: fice or sea ice concentration from the mediator !----------------------------------------------------------------------- fldname = 'ice_fraction' - if (trim(impfield_name) == trim(fldname)) then + if (trim(impfield_name) == trim(fldname) .and. GFS_control%kdt > 1) then findex = QueryFieldList(ImportFieldsList,fldname) if (importFieldsValid(findex)) then lcpl_fice = .true. From 68f77cb5eb0ecb3a3af14fcca1533f659a1b57a3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 18 Feb 2021 07:29:41 -0500 Subject: [PATCH 119/217] turning off a print in atmos_model and removing Rayleigh friction in suite_FV3_GFS_v17_ras.xml --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 4 ++-- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v17_ras.xml | 1 - 4 files changed, 4 insertions(+), 5 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 142daafd0..4d15e02d8 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 142daafd0dfdb92fef75aa5f22b101729ef58ddc +Subproject commit 4d15e02d8e96e140b6c31b18e905eb3854368256 diff --git a/atmos_model.F90 b/atmos_model.F90 index aec14cff6..62f75e961 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2502,7 +2502,7 @@ subroutine setup_exportdata (rc) ! bottom layer temperature (t) idx = queryfieldlist(exportFieldsList,'inst_temp_height_lowest') - if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest' +! if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest' if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) do j=jsc,jec @@ -2516,7 +2516,7 @@ subroutine setup_exportdata (rc) endif enddo enddo - if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest=',exportData(isc,jsc,idx) + if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest=',exportData(isc,jsc,idx) endif ! bottom layer specific humidity (q) diff --git a/ccpp/physics b/ccpp/physics index 5a1454e16..930ffab4b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5a1454e164c28168a262ffe845fe668735e09b8b +Subproject commit 930ffab4b66092c8a3c2aff9f8f08b3007e6c9b3 diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras.xml b/ccpp/suites/suite_FV3_GFS_v17_ras.xml index a729a0c83..631107e0e 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_ras.xml @@ -64,7 +64,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys From b378e305ff85248ed85dd9911c7934d8f30c6fbf Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 2 Mar 2021 20:19:41 +0000 Subject: [PATCH 120/217] after submodule sync --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 30472fb57..925020b72 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 30472fb57d94e19ddf0dddc6828f0543a03fe35a +Subproject commit 925020b72d242ff6101f167a14c0a535c865e987 From e12ca08ff3229080f4e5d81815d41096d86b9d04 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 11 Mar 2021 14:27:34 -0500 Subject: [PATCH 121/217] fixing fscav in data/GFS_typedefs.F90 --- ccpp/data/GFS_typedefs.F90 | 4 +++- ccpp/physics | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 545d97d7d..afbf5c6b0 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -4233,7 +4233,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & endif ! -- setup aerosol scavenging factors - allocate(Model%fscav(Model%ntchm)) + n = max(Model%ntrac, Model%ntchm) + allocate(Model%fscav(n)) + Model%fscav = -9999.0 if (Model%ntchm > 0) then ! -- initialize to default Model%fscav = 0.6_kind_phys diff --git a/ccpp/physics b/ccpp/physics index bea0e5e5a..fa43e9977 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit bea0e5e5ac724a3ee4f5dbd7e86b0b35f44f536e +Subproject commit fa43e99778cd225dafcb05db56bd2e49e20b8eeb From 7c72a493a8e37de7f15f5709f97fc73b46128330 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 16 Mar 2021 09:20:38 -0400 Subject: [PATCH 122/217] updates to CMake from Dom --- ccpp/data/CMakeLists.txt | 8 ++++++-- ccpp/driver/CMakeLists.txt | 12 ++++++++---- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/ccpp/data/CMakeLists.txt b/ccpp/data/CMakeLists.txt index 71ba6311d..b99455eaf 100644 --- a/ccpp/data/CMakeLists.txt +++ b/ccpp/data/CMakeLists.txt @@ -32,8 +32,12 @@ add_library( CCPP_data.F90 ) -target_link_libraries(ccppdata ccpp) -target_link_libraries(ccppdata ccppphys) +target_link_libraries(ccppdata PUBLIC ccpp) +target_link_libraries(ccppdata PUBLIC ccppphys) + +if(OpenMP_Fortran_FOUND) + target_link_libraries(ccppdata PUBLIC OpenMP::OpenMP_Fortran) +endif() target_include_directories(ccppdata PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) diff --git a/ccpp/driver/CMakeLists.txt b/ccpp/driver/CMakeLists.txt index 923ef27c6..2717f0be3 100644 --- a/ccpp/driver/CMakeLists.txt +++ b/ccpp/driver/CMakeLists.txt @@ -38,13 +38,17 @@ add_library( # Compile GFS_diagnostics.F90 without optimization, this leads to out of memory errors on wcoss_dell_p3 set_property(SOURCE GFS_diagnostics.F90 APPEND_STRING PROPERTY COMPILE_FLAGS "-O0") -target_link_libraries(ccppdriver ccpp) -target_link_libraries(ccppdriver ccppphys) -target_link_libraries(ccppdriver ccppdata) +target_link_libraries(ccppdriver PUBLIC ccpp) +target_link_libraries(ccppdriver PUBLIC ccppphys) +target_link_libraries(ccppdriver PUBLIC ccppdata) + +if(OpenMP_Fortran_FOUND) + target_link_libraries(ccppdriver PUBLIC OpenMP::OpenMP_Fortran) +endif() target_include_directories(ccppdriver PRIVATE ${CMAKE_BINARY_DIR}/FV3/ccpp/framework/src ${CMAKE_BINARY_DIR}/FV3/ccpp/physics) set_target_properties(ccppdriver PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) -target_compile_definitions(ccppdata PRIVATE "${_ccppdata_defs_private}") +target_compile_definitions(ccppdriver PRIVATE "${_ccppdata_defs_private}") target_include_directories(ccppdriver PUBLIC $) From a2b73e6a7933c5e7da41c8a5d870a7cf636f04ce Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 20 Mar 2021 21:46:15 -0400 Subject: [PATCH 123/217] updating inline post routines to reduce post printout --- io/post_gfs.F90 | 3 ++- io/post_nems_routines.F90 | 14 +++++++------- io/post_regional.F90 | 3 ++- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 1a569b6e9..aba1df7ff 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -29,7 +29,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,im, nsoil, filenameflat, me use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -81,6 +81,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount + me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct diff --git a/io/post_nems_routines.F90 b/io/post_nems_routines.F90 index 4d0792284..5f6bc73ec 100644 --- a/io/post_nems_routines.F90 +++ b/io/post_nems_routines.F90 @@ -19,10 +19,10 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & use vrbls2d use soil use masks, only: lmv, lmh, htm, vtm - use ctlblk_mod, only: im, jm, lm, im_jm, lp1, grib, gdsdegr, me, & - ioform, jsta, jend, jsta_m, jsta_m2, & + use ctlblk_mod, only: im, jm, lm, im_jm, lp1, grib, gdsdegr, me, & + ioform, jsta, jend, jsta_m, jsta_m2, & jend_m, jend_m2, jvend_2u, jsta_2l, jend_2u, iup, idn, & - icnt, idsp, mpi_comm_comp, num_servers, & + icnt, idsp, mpi_comm_comp, num_servers, & num_procs ! !----------------------------------------------------------------------- @@ -58,7 +58,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! set ndegr gdsdegr = 1000000. IOFORM = 'grib' - me = mype-lead_write +! me = mype-lead_write last_write_task = lead_write+nwtlpes-1 mpi_comm_comp = mpicomp num_procs = nwtlpes @@ -162,7 +162,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) !--- character (len=*), intent(in) :: post_namelist integer :: kpo,kth,kpv,nlunit - real :: untcnvt + real :: untcnvt logical :: popascal real,dimension(komax) :: po,th,pv namelist/nampgb/kpo,po,kth,th,kpv,pv,popascal,d3d_on,gocart_on, & @@ -199,7 +199,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) endif 119 continue if (me == 0) then - print*,'komax,iret for nampgb= ',komax,iret + print*,'komax,iret for nampgb= ',komax,iret,' me=',me print*,'komax,kpo,kth,th,kpv,pv,popascal== ',komax,kpo & & ,kth,th(1:kth),kpv,pv(1:kpv),popascal,' gocart_on=',gocart_on endif @@ -238,7 +238,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) lsmp1 = lsm + 1 pthresh = 0.000001 if (me==0) print*,'LSM, SPL = ',lsm,spl(1:lsm),' pthresh=', & - pthresh + pthresh,' me=',me ! ! set default novegtype for GFS, need to get this variable from gfs physics novegtype = 20 diff --git a/io/post_regional.F90 b/io/post_regional.F90 index eecd5c10f..3fabd5d42 100644 --- a/io/post_regional.F90 +++ b/io/post_regional.F90 @@ -33,7 +33,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,im, nsoil, filenameflat, me use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl @@ -85,6 +85,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount + me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct From d6da5a5e3d00c21ae5bbbc526848ca29296c9f32 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 23 Mar 2021 07:08:44 -0400 Subject: [PATCH 124/217] updating CMakeLists.txt to be able to compile withe SM_Mar222021 branch of dynamics --- CMakeLists.txt | 5 +++++ atmos_cubed_sphere | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4b0947f55..22d84ea76 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -47,8 +47,12 @@ list(APPEND _fv3dycore_srcs atmos_cubed_sphere/model/tp_core.F90 atmos_cubed_sphere/model/nh_core.F90 atmos_cubed_sphere/model/nh_utils.F90 + atmos_cubed_sphere/tools/coarse_grained_diagnostics.F90 + atmos_cubed_sphere/tools/coarse_grained_restart_files.F90 + atmos_cubed_sphere/tools/coarse_graining.F90 atmos_cubed_sphere/tools/external_ic.F90 atmos_cubed_sphere/tools/external_sst.F90 + atmos_cubed_sphere/tools/fv_diag_column.F90 atmos_cubed_sphere/tools/fv_diagnostics.F90 atmos_cubed_sphere/tools/fv_eta.F90 atmos_cubed_sphere/tools/fv_grid_tools.F90 @@ -103,6 +107,7 @@ set_target_properties(fv3dycore PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURR target_compile_definitions(fv3dycore PRIVATE "${_fv3dycore_defs_private}") target_include_directories(fv3dycore PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere + ${CMAKE_CURRENT_SOURCE_DIR}/atmos_cubed_sphere/tools ${CMAKE_CURRENT_BINARY_DIR}/ccpp/driver/mod) target_include_directories(fv3dycore INTERFACE $ $) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 4d15e02d8..3cfe1af9b 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 4d15e02d8e96e140b6c31b18e905eb3854368256 +Subproject commit 3cfe1af9b46fce973cadab901be82e4c0d614306 From 7fd139c64fcaae0d4ee89cba4ad4540c5b247e31 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 31 Mar 2021 14:33:30 -0400 Subject: [PATCH 125/217] modify atmos_model.F90 to skip stochastic physics call when not turned on via namelist variables --- atmos_model.F90 | 41 ++++++++++++++++++++++++++++++----------- 1 file changed, 30 insertions(+), 11 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 228aa9c9d..1d14f8792 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -260,9 +260,12 @@ subroutine update_atmos_radiation_physics (Atmos) call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then !--- call stochastic physics pattern generation / cellular automata - call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) - if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') + call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') + endif !--- if coupled, assign coupled fields @@ -334,14 +337,19 @@ subroutine update_atmos_radiation_physics (Atmos) call FV3GFS_GFS_checksum(GFS_control, GFS_data, Atm_block) endif - if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "stochastic physics driver" + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + + if (mpp_pe() == mpp_root_pe() .and. debug) write(6,*) "stochastic physics driver" !--- execute the IPD atmospheric physics step2 subcomponent (stochastic physics driver) - call mpp_clock_begin(physClock) - call CCPP_step (step="stochastics", nblks=Atm_block%nblks, ierr=ierr) - if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP stochastics step failed') - call mpp_clock_end(physClock) + call mpp_clock_begin(physClock) + call CCPP_step (step="stochastics", nblks=Atm_block%nblks, ierr=ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP stochastics step failed') + call mpp_clock_end(physClock) + + endif if (chksum_debug) then if (mpp_pe() == mpp_root_pe()) print *,'PHYSICS STEP2 ', GFS_control%kdt, GFS_control%fhour @@ -601,9 +609,14 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call CCPP_step (step="physics_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed') + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + !--- Initialize stochastic physics pattern generation / cellular automata for first time step - call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) - if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') + call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) + if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') + + endif !--- set the initial diagnostic timestamp diag_time = Time @@ -882,9 +895,15 @@ subroutine atmos_model_end (Atmos) if(restart_endfcst) then call FV3GFS_restart_write (GFS_data, GFS_restart_var, Atm_block, & GFS_control, Atmos%domain) - call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') +! call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') + endif + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + if(restart_endfcst) then + call write_stoch_restart_atm('RESTART/atm_stoch.res.nc') + endif + call stochastic_physics_wrapper_end(GFS_control) endif - call stochastic_physics_wrapper_end(GFS_control) ! Fast physics (from dynamics) are finalized in atmosphere_end above; ! standard/slow physics (from IPD) are finalized in CCPP_step 'finalize'. From 6d655b64d40c836cf7987e5987907562d483bcf7 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 31 Mar 2021 19:24:59 -0400 Subject: [PATCH 126/217] updating .gitmodules --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index fc93fae14..3c7abdf0f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Sep302020 + branch = SM_Mar222021 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/ccpp/physics b/ccpp/physics index ee61e9140..a3b1ebdfa 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ee61e9140a7581f4942cb44af3af18b791e9f87d +Subproject commit a3b1ebdfa03b1dce06a4f3d1627020a2010de812 From 309faef1cbe4ad6061849c0c6a23d30472ba89de Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 2 Apr 2021 14:36:48 -0400 Subject: [PATCH 127/217] syncinc submodules --- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 3cfe1af9b..c1b019869 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 3cfe1af9b46fce973cadab901be82e4c0d614306 +Subproject commit c1b01986941ab039af1dc6cc7e338deba339dc07 diff --git a/ccpp/physics b/ccpp/physics index a3b1ebdfa..cad064986 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a3b1ebdfa03b1dce06a4f3d1627020a2010de812 +Subproject commit cad064986faa53487f260d96429eec825a9b9701 From 5d064c1ce7e0ecfe3c2700d785878240dab3c3fd Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 5 Apr 2021 20:02:17 -0400 Subject: [PATCH 128/217] after syncing submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index cad064986..680e32bac 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cad064986faa53487f260d96429eec825a9b9701 +Subproject commit 680e32bac7e2821a5df2b1ad2bf48b03e4ad30b0 From 0080be760112ead09e263bb71f71cfc6706009d5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 5 Apr 2021 21:00:46 -0400 Subject: [PATCH 129/217] updating .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 3c7abdf0f..e8e985da2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Dec022020 + branch = SM_Mar222021 From 0c19ad9c3b971138dd57a039e343fc5cce69085d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 15 Apr 2021 20:45:45 -0400 Subject: [PATCH 130/217] adding zorlw line that was accidentally deleted --- atmos_model.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/atmos_model.F90 b/atmos_model.F90 index c42f29e81..ad07e0df9 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1634,6 +1634,7 @@ subroutine assign_importdata(rc) tem = 100.0_GFS_kind_phys * min(0.1_GFS_kind_phys, datar8(i,j)) ! GFS_data(nb)%Coupling%zorlwav_cpl(ix) = tem GFS_data(nb)%Sfcprop%zorlwav(ix) = tem + GFS_data(nb)%Sfcprop%zorlw(ix) = tem else GFS_data(nb)%Sfcprop%zorlwav(ix) = -999.0_GFS_kind_phys From ed1e2240824904dfc247c2a5599f9d824483c7d1 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 19 Apr 2021 14:23:08 -0400 Subject: [PATCH 131/217] updateing .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index e8e985da2..8d58ec6e2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Mar222021 + branch = SM_Apr122021 From b77094f67ba7530b19aaa848bd9b74e0cd61d5a3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Apr 2021 15:21:03 -0400 Subject: [PATCH 132/217] minor fix to io/FV4GFS_io.F90 and syncing submodules --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 20 ++++++++------------ 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index be7980fe2..0f227e86c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit be7980fe2246976c7e3e53d7ea803379f1abae6c +Subproject commit 0f227e86c03ea777f49e0b718f96a35e4de57a07 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 82d14446b..f22114824 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1026,10 +1026,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (nint(Sfcprop(nb)%slmsk(ix)) /= one) then + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then Sfcprop(nb)%slmsk(ix) = 2 else @@ -1039,7 +1039,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta else Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (nint(Sfcprop(nb)%slmsk(ix)) /= one) then + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then Sfcprop(nb)%slmsk(ix) = 2 else @@ -1048,8 +1048,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == one) then - Sfcprop(nb)%landfrac(ix) = one + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero else @@ -1075,6 +1075,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%slmsk(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%slmsk(ix) = one @@ -1086,7 +1087,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == one) then + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero @@ -1272,13 +1273,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%keepsmfr(ix,lsoil) = sfc_var3(i,j,lsoil,4) !--- keepsmfr Sfcprop(nb)%flag_frsoil(ix,lsoil) = sfc_var3(i,j,lsoil,5) !--- flag_frsoil enddo - end if - - do k = 1,Model%kice - Sfcprop(nb)%tiice(ix,k)= sfc_var3ice(i,j,k) !--- internal ice temp - enddo + endif -! internal ice temperature do k = 1,Model%kice Sfcprop(nb)%tiice(ix,k) = sfc_var3ice(i,j,k) !--- internal ice temp enddo From fefefea1d69226746f286acea97612457b6c0a86 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Apr 2021 19:40:03 -0400 Subject: [PATCH 133/217] updating ccpp-physics --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 8d58ec6e2..bf2f45f2f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Apr122021 + branch = SM_May012021 From 7e82ddcb9e67f6b467a45b89520b42a9d739d56b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Apr 2021 19:44:35 -0400 Subject: [PATCH 134/217] after syncing submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 0f227e86c..d3075b6bf 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0f227e86c03ea777f49e0b718f96a35e4de57a07 +Subproject commit d3075b6bf0d259871cf446e7c0ee026f528cafc4 From b191e00c28d27e39f7983f35bb6f9c34ccaa460b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 4 May 2021 19:07:12 -0400 Subject: [PATCH 135/217] after submodule sync --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 0ee7f617c..d4d90c9e8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0ee7f617c69be92315ecf2568f2cdadcd1cc5e55 +Subproject commit d4d90c9e86509b84a21f3ce0bda6c3c38a4bd57c From 519c9baa212ae02a359af629dc97e87777e075f2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 7 May 2021 20:54:08 -0400 Subject: [PATCH 136/217] adding a few new suites and removing rayleigh fomr some suites --- ccpp/data/GFS_typedefs.F90 | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml | 1 - .../suite_FV3_GFS_cpld_rasmgshocnsst.xml | 1 - ...suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml | 91 ++++++++++++++++++ .../suite_FV3_GFS_cpldnst_rasmgshoc.xml | 1 - ccpp/suites/suite_FV3_GFS_rasmgshoc.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_ras.xml | 1 - ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml | 1 - ccpp/suites/suite_FV3_GFS_v15plusras.xml | 1 - ccpp/suites/suite_FV3_GFS_v16_ras.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml | 1 - .../suite_FV3_GFS_v17_cpldnsstras_flake.xml | 95 +++++++++++++++++++ .../suite_FV3_GFS_v17_cpldnsstrasnoshal.xml | 1 - ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml | 94 ++++++++++++++++++ 16 files changed, 283 insertions(+), 13 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml create mode 100644 ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 4ce13372d..2840433d9 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3156,7 +3156,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: sfenth = 0.0 !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s !--- flake model parameters - integer :: lkm = 0 !< flag for flake model + integer :: lkm = 0 !< flag for flake model - default no flake !--- tuning parameters for physical parameterizations logical :: ras = .false. !< flag for ras convection scheme diff --git a/ccpp/framework b/ccpp/framework index 186e76d3e..b6593e0da 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 186e76d3e6b03a719303e5e608498e8354caa278 +Subproject commit b6593e0daa6c014dd1c2ede8d29ef11914da5180 diff --git a/ccpp/physics b/ccpp/physics index 0ee7f617c..cfdd5ad52 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0ee7f617c69be92315ecf2568f2cdadcd1cc5e55 +Subproject commit cfdd5ad52f248b453a9994a39e0245cfd6198bb6 diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml index 7f4532fd8..a348fb0ba 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshoc.xml @@ -58,7 +58,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml index e10379552..772fcad30 100644 --- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml @@ -60,7 +60,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.xml new file mode 100644 index 000000000..1562f538c --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst_flake.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 + lsm_noah + flake_driver + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + 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 + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml index 0527a5675..d1c655994 100644 --- a/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_cpldnst_rasmgshoc.xml @@ -60,7 +60,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml index b3d21d014..d735a74fc 100644 --- a/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_rasmgshoc.xml @@ -59,7 +59,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v15_ras.xml b/ccpp/suites/suite_FV3_GFS_v15_ras.xml index d182e78e0..1412f3ba2 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_ras.xml @@ -64,7 +64,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml index 9411ef974..b28816160 100644 --- a/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml +++ b/ccpp/suites/suite_FV3_GFS_v15_rasmgshoc.xml @@ -59,7 +59,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v15plusras.xml b/ccpp/suites/suite_FV3_GFS_v15plusras.xml index 49b422bc6..c65747180 100644 --- a/ccpp/suites/suite_FV3_GFS_v15plusras.xml +++ b/ccpp/suites/suite_FV3_GFS_v15plusras.xml @@ -64,7 +64,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v16_ras.xml b/ccpp/suites/suite_FV3_GFS_v16_ras.xml index 4a7fc2b27..7265f6499 100644 --- a/ccpp/suites/suite_FV3_GFS_v16_ras.xml +++ b/ccpp/suites/suite_FV3_GFS_v16_ras.xml @@ -64,7 +64,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml index d73a3e552..3b9eaf588 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml @@ -65,7 +65,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml new file mode 100644 index 000000000..d15db96b5 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + lsm_noah + flake_driver + sfc_nst_pre + sfc_nst + sfc_nst_post + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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 + phys_tend + + + + diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml index e9bb7477a..47110dfb3 100644 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml +++ b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml @@ -65,7 +65,6 @@ cires_ugwp cires_ugwp_post GFS_GWD_generic_post - rayleigh_damp GFS_suite_stateout_update ozphys_2015 h2ophys diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml b/ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml new file mode 100644 index 000000000..e89083278 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v17_ras_flake.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 + lsm_noah + sfc_nst_pre + sfc_nst + sfc_nst_post + flake_driver + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + 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 + phys_tend + + + + From e66901fab9f53055654dc36d9ab408e2d0b62bdb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 May 2021 20:24:50 -0400 Subject: [PATCH 137/217] some comment update in GFS_typedefs.F90 --- ccpp/data/GFS_typedefs.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 2840433d9..8993b701b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -231,10 +231,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tiice(:,:) => null() !< internal ice temperature 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 :: zorlw (:) => null() !< wave surface roughness in cm + real (kind=kind_phys), pointer :: zorlw (:) => null() !< water surface roughness in cm real (kind=kind_phys), pointer :: zorll (:) => null() !< land surface roughness in cm real (kind=kind_phys), pointer :: zorli (:) => null() !< ice surface roughness in cm - real (kind=kind_phys), pointer :: zorlwav(:) => null() !< cwwater surface roughness in cm derived from wave model + real (kind=kind_phys), pointer :: zorlwav(:) => null() !< wave surface roughness in cm derived from wave model 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 @@ -1546,7 +1546,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: skebv_wts(:,:) => null() !< 10 meter v wind speed real (kind=kind_phys), pointer :: sppt_wts(:,:) => null() !< real (kind=kind_phys), pointer :: shum_wts(:,:) => null() !< - real (kind=kind_phys), pointer :: sfc_wts(:,:) => null() !< + real (kind=kind_phys), pointer :: sfc_wts(:,:) => null() !< real (kind=kind_phys), pointer :: zmtnblck(:) => null() ! null() !< u momentum change due to physics real (kind=kind_phys), pointer :: dv3dt (:,:,:) => null() !< v momentum change due to physics @@ -2707,7 +2707,7 @@ subroutine coupling_create (Coupling, IM, Model) ! allocate (Coupling%zorlwav_cpl (IM)) ! Coupling%zorlwav_cpl = clear_val -! end if +! endif if (Model%cplflx) then !--- incoming quantities @@ -5309,7 +5309,7 @@ subroutine grid_create (Grid, IM, Model) implicit none - class(GFS_grid_type) :: Grid + class(GFS_grid_type) :: Grid integer, intent(in) :: IM type(GFS_control_type), intent(in) :: Model From a7e6f5cf4aa7792aa40287fa9cd236a81dda83a9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 10 May 2021 21:24:33 -0400 Subject: [PATCH 138/217] after syncing --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index cfdd5ad52..aff96dda2 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cfdd5ad52f248b453a9994a39e0245cfd6198bb6 +Subproject commit aff96dda201d4309b3b2a9def09b96c99ce2c70e From 455b3946f331fa1e74f3283216d04073f94c1ca8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 11 May 2021 12:46:58 -0400 Subject: [PATCH 139/217] updating to include separate logicvals lake and use_flake, the latter meaing using flake model for lake --- ccpp/data/GFS_typedefs.F90 | 4 ++++ ccpp/data/GFS_typedefs.meta | 6 ++++++ ccpp/physics | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 8993b701b..76d7932df 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1851,6 +1851,7 @@ module GFS_typedefs integer, pointer :: idxday(:) => null() !< logical, pointer :: icy(:) => null() !< logical, pointer :: lake(:) => null() !< + logical, pointer :: use_flake(:) => null() !< logical, pointer :: ocean(:) => null() !< integer :: ipr !< integer, pointer :: islmsk(:) => null() !< @@ -6387,6 +6388,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%idxday (IM)) allocate (Interstitial%icy (IM)) allocate (Interstitial%lake (IM)) + allocate (Interstitial%use_flake (IM)) allocate (Interstitial%ocean (IM)) allocate (Interstitial%islmsk (IM)) allocate (Interstitial%islmsk_cice (IM)) @@ -7140,6 +7142,7 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%dry = .false. Interstitial%icy = .false. Interstitial%lake = .false. + Interstitial%use_flake = .false. Interstitial%ocean = .false. Interstitial%islmsk = 0 Interstitial%islmsk_cice = 0 @@ -7498,6 +7501,7 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%idxday ) = ', sum(Interstitial%idxday ) write (0,*) 'Interstitial%icy(:)==.true. = ', count(Interstitial%icy(:) ) write (0,*) 'Interstitial%lake(:)==.true. = ', count(Interstitial%lake(:) ) + write (0,*) 'Interstitial%use_flake(:)==.true. = ', count(Interstitial%use_flake(:) ) write (0,*) 'Interstitial%ocean(:)==.true. = ', count(Interstitial%ocean(:) ) write (0,*) 'sum(Interstitial%islmsk ) = ', sum(Interstitial%islmsk ) write (0,*) 'sum(Interstitial%islmsk_cice ) = ', sum(Interstitial%islmsk_cice ) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index cb7def297..91a758960 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -8845,6 +8845,12 @@ units = flag dimensions = (horizontal_loop_extent) type = logical +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = logical [ocean] standard_name = flag_nonzero_ocean_surface_fraction long_name = flag indicating presence of some ocean surface area fraction diff --git a/ccpp/physics b/ccpp/physics index aff96dda2..d4fe66591 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit aff96dda201d4309b3b2a9def09b96c99ce2c70e +Subproject commit d4fe665917165d72b82309d4d0dde30537d5cf2d From 9b6a3bab32e1693bca4ac2ff56ce278077d4a930 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 11 May 2021 21:09:18 -0400 Subject: [PATCH 140/217] some cosmetic change and submodule sync --- .gitmodules | 2 +- atmos_cubed_sphere | 2 +- atmos_model.F90 | 946 ++++++++++++++++++++++----------------------- 3 files changed, 475 insertions(+), 475 deletions(-) diff --git a/.gitmodules b/.gitmodules index bf2f45f2f..9703e5291 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Mar222021 + branch = SM_May042021 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 3342868ae..d3c30ef28 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 3342868ae5bbe1673dc45f623e720274430091a1 +Subproject commit d3c30ef28f75a5e572ec8f5877325274bf2e0da4 diff --git a/atmos_model.F90 b/atmos_model.F90 index ad07e0df9..b9733e09d 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1959,9 +1959,9 @@ subroutine setup_exportdata (rc) rtime = one / GFS_control%dtp rtimek = GFS_control%rho_h2o * rtime -! print *,'in cplExp,dim=',isc,iec,jsc,jec,'nExportFields=',nExportFields -! print *,'in cplExp,GFS_data, size', size(GFS_data) -! print *,'in cplExp,u10micpl, size', size(GFS_data(1)%coupling%u10mi_cpl) +! print *,'in cplExp,dim=',isc,iec,jsc,jec,'nExportFields=',nExportFields +! print *,'in cplExp,GFS_data, size', size(GFS_data) +! print *,'in cplExp,u10micpl, size', size(GFS_data(1)%coupling%u10mi_cpl) if(.not.allocated(exportData)) then allocate(exportData(isc:iec,jsc:jec,nExportFields)) @@ -1971,678 +1971,678 @@ subroutine setup_exportdata (rc) if (GFS_control%cplflx .or. GFS_control%cplwav) then ! Instantaneous u wind (m/s) 10 m above ground - idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height10m') - if (idx > 0 ) then - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get u10mi_cpl' + idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height10m') + if (idx > 0 ) then + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get u10mi_cpl' !$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) - exportData(i,j,idx) = GFS_data(nb)%coupling%u10mi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%u10mi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instantaneous v wind (m/s) 10 m above ground - idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height10m') - if (idx > 0 ) then - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get v10mi_cpl' + idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height10m') + if (idx > 0 ) then + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, in get v10mi_cpl' !$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) - exportData(i,j,idx) = GFS_data(nb)%coupling%v10mi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%v10mi_cpl(ix) + enddo enddo - enddo - if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, get v10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx - endif + if (mpp_pe() == mpp_root_pe() .and. debug) print *,'cpl, get v10mi_cpl, exportData=',exportData(isc,jsc,idx),'idx=',idx + endif endif !if cplflx or cplwav if (GFS_control%cplflx) then ! MEAN Zonal compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'mean_zonal_moment_flx_atm') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_zonal_moment_flx_atm') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dusfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN Merid compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'mean_merid_moment_flx_atm') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_merid_moment_flx_atm') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN Sensible heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_sensi_heat_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_sensi_heat_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN Latent heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_laten_heat_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_laten_heat_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN Downward LW heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_lw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_lw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN Downward SW heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_sw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN precipitation rate (kg/m2/s) - idx = queryfieldlist(exportFieldsList,'mean_prec_rate') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_prec_rate') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%rain_cpl(ix) * rtimek + enddo enddo - enddo - endif + endif ! Instataneous Zonal compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'inst_zonal_moment_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_zonal_moment_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dusfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dusfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Merid compt of momentum flux (N/m**2) - idx = queryfieldlist(exportFieldsList,'inst_merid_moment_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_merid_moment_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Sensible heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_sensi_heat_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_sensi_heat_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dtsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Latent heat flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_laten_heat_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_laten_heat_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dqsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Downward long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_lw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_lw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dlwsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Downward solar radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_sw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dswsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Temperature (K) 2 m above ground - idx = queryfieldlist(exportFieldsList,'inst_temp_height2m') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_temp_height2m') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%t2mi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%t2mi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Specific humidity (kg/kg) 2 m above ground - idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height2m') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height2m') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%q2mi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%q2mi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Temperature (K) at surface - idx = queryfieldlist(exportFieldsList,'inst_temp_height_surface') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_temp_height_surface') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%tsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%tsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Pressure (Pa) land and sea surface - idx = queryfieldlist(exportFieldsList,'inst_pres_height_surface') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_pres_height_surface') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%psurfi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%psurfi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous Surface height (m) - idx = queryfieldlist(exportFieldsList,'inst_surface_height') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_surface_height') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%oro_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%oro_cpl(ix) + enddo enddo - enddo - endif + endif ! MEAN NET long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_lw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_lw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN NET solar radiation flux over the ocean (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_sw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfc_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! Instataneous NET long wave radiation flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_lw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_lw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nlwsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous NET solar radiation flux over the ocean (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_sw_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfci_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nswsfci_cpl(ix) + enddo enddo - enddo - endif + endif ! MEAN sfc downward nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbm_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN sfc downward nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_sw_ir_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdf_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN sfc downward uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbm_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN sfc downward uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_down_sw_vis_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdf_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! Instataneous sfc downward nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirbmi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous sfc downward nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_sw_ir_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dnirdfi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous sfc downward uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisbmi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous sfc downward uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_down_sw_vis_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%dvisdfi_cpl(ix) + enddo enddo - enddo - endif + endif ! MEAN NET sfc nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbm_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN NET sfc nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_sw_ir_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdf_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN NET sfc uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbm_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! MEAN NET sfc uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_net_sw_vis_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdf_cpl(ix) * rtime + enddo enddo - enddo - endif + endif ! Instataneous net sfc nir direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirbmi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous net sfc nir diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_sw_ir_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nnirdfi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous net sfc uv+vis direct flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dir_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dir_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisbmi_cpl(ix) + enddo enddo - enddo - endif + endif ! Instataneous net sfc uv+vis diffused flux (W/m**2) - idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dif_flx') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_net_sw_vis_dif_flx') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%nvisdfi_cpl(ix) + enddo enddo - enddo - endif + endif ! Land/Sea mask (sea:0,land:1) - idx = queryfieldlist(exportFieldsList,'inst_land_sea_mask') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_land_sea_mask') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%slmsk_cpl(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%slmsk_cpl(ix) + enddo enddo - enddo - endif + endif ! Data from DYCORE: ! bottom layer temperature (t) - idx = queryfieldlist(exportFieldsList,'inst_temp_height_lowest') -! if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest' - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_temp_height_lowest') +! if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest' + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%t_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%t_bot(ix) - else - exportData(i,j,idx) = zero - endif + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (associated(DYCORE_Data(nb)%coupling%t_bot)) then + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%t_bot(ix) + else + exportData(i,j,idx) = zero + endif + enddo enddo - enddo - if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest=',exportData(isc,jsc,idx) - endif + if (mpp_pe() == mpp_root_pe()) print *,'cpl, in get inst_temp_height_lowest=',exportData(isc,jsc,idx) + endif ! bottom layer specific humidity (q) !!! CHECK if tracer 1 is for specific humidity !!! - idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height_lowest') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_spec_humid_height_lowest') + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%tr_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) - else - exportData(i,j,idx) = zero - endif + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (associated(DYCORE_Data(nb)%coupling%tr_bot)) then + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%tr_bot(ix,1) + else + exportData(i,j,idx) = zero + endif + enddo enddo - enddo - endif + endif ! bottom layer zonal wind (u) - idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height_lowest') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_zonal_wind_height_lowest') + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%u_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%u_bot(ix) - else - exportData(i,j,idx) = zero - endif + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (associated(DYCORE_Data(nb)%coupling%u_bot)) then + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%u_bot(ix) + else + exportData(i,j,idx) = zero + endif + enddo enddo - enddo - endif + endif ! bottom layer meridionalw wind (v) - idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height_lowest') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_merid_wind_height_lowest') + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%v_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%v_bot(ix) - else - exportData(i,j,idx) = zero - endif + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (associated(DYCORE_Data(nb)%coupling%v_bot)) then + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%v_bot(ix) + else + exportData(i,j,idx) = zero + endif + enddo enddo - enddo - endif + endif ! bottom layer pressure (p) - idx = queryfieldlist(exportFieldsList,'inst_pres_height_lowest') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_pres_height_lowest') + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (associated(DYCORE_Data(nb)%coupling%p_bot)) then - exportData(i,j,idx) = DYCORE_Data(nb)%coupling%p_bot(ix) - else - exportData(i,j,idx) = zero - endif + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + if (associated(DYCORE_Data(nb)%coupling%p_bot)) then + exportData(i,j,idx) = DYCORE_Data(nb)%coupling%p_bot(ix) + else + exportData(i,j,idx) = zero + endif + enddo enddo - enddo - endif + endif ! bottom layer height (z) - idx = queryfieldlist(exportFieldsList,'inst_height_lowest') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'inst_height_lowest') + if (idx > 0 ) then !$omp parallel do default(shared) private(i,j,nb,ix) - do j=jsc,jec - do i=isc,iec - nb = Atm_block%blkno(i,j) - ix = Atm_block%ixp(i,j) - if (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 + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + 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 + enddo enddo - enddo - endif + endif ! END Data from DYCORE. ! MEAN snow precipitation rate (kg/m2/s) - idx = queryfieldlist(exportFieldsList,'mean_fprec_rate') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'mean_fprec_rate') + if (idx > 0 ) 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) - exportData(i,j,idx) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = GFS_data(nb)%coupling%snow_cpl(ix) * rtimek + enddo enddo - enddo - endif + endif ! oceanfrac used by atm to calculate fluxes - idx = queryfieldlist(exportFieldsList,'openwater_frac_in_atm') - if (idx > 0 ) then + idx = queryfieldlist(exportFieldsList,'openwater_frac_in_atm') + if (idx > 0 ) 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) - exportData(i,j,idx) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + exportData(i,j,idx) = (one - GFS_Data(nb)%Sfcprop%fice(ix))*GFS_Data(nb)%Sfcprop%oceanfrac(ix) + enddo enddo - enddo - endif + endif endif !cplflx From 03aadb9cd36140dbd0003d9035155fa660cc83f9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 12 May 2021 15:25:30 -0400 Subject: [PATCH 141/217] after submodule sync --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index d3c30ef28..2be2f3598 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit d3c30ef28f75a5e572ec8f5877325274bf2e0da4 +Subproject commit 2be2f3598cff435bf101f1d4e7b5389e22df2428 From 2c7b58bd7476ae3938ab77deb89e13de01f77cdb Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 14 May 2021 21:13:49 -0400 Subject: [PATCH 142/217] creating a version without ncld --- ccpp/data/GFS_typedefs.F90 | 22 ++++++++++++---------- ccpp/data/GFS_typedefs.meta | 6 ------ ccpp/physics | 2 +- io/FV3GFS_io.F90 | 3 ++- 4 files changed, 15 insertions(+), 18 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 76d7932df..74d820c25 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -695,7 +695,6 @@ module GFS_typedefs real(kind_phys) :: minGPtemp !< Minimum temperature allowed in RRTMGP. !--- microphysical switch - integer :: ncld !< choice of cloud scheme logical :: convert_dry_rho = .true. !< flag for converting mass/number concentrations from moist to dry !< for physics options that expect dry mass/number concentrations; !< this flag will no longer be needed once the CCPP standard @@ -1112,7 +1111,7 @@ module GFS_typedefs integer :: ntrnc !< tracer index for rain number concentration integer :: ntsnc !< tracer index for snow number concentration integer :: ntgnc !< tracer index for graupel number concentration - integer :: ntke !< tracer index for kinetic energy + integer :: ntke !< tracer index for sgs kinetic energy integer :: nto !< tracer index for oxygen ion integer :: nto2 !< tracer index for oxygen integer :: ntwa !< tracer index for water friendly aerosol @@ -3055,7 +3054,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: use_LW_jacobian = .false. !< Use Jacobian of LW to update LW radiation tendencies. logical :: doGP_lwscat = .false. !< If true, include scattering in longwave cloud-optics, only compatible w/ GP cloud-optics !--- Z-C microphysical parameters - integer :: ncld = 1 !< choice of cloud scheme integer :: imp_physics = 99 !< choice of cloud scheme real(kind=kind_phys) :: psautco(2) = (/6.0d-4,3.0d-4/) !< [in] auto conversion coeff from ice to snow real(kind=kind_phys) :: prautco(2) = (/1.0d-4,1.0d-4/) !< [in] auto conversion coeff from cloud to rain @@ -3439,7 +3437,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! IN CCN forcing iccn, & !--- microphysical parameterizations - ncld, imp_physics, psautco, prautco, evpco, wminco, & + imp_physics, psautco, prautco, evpco, wminco, & fprcp, pdfflag, mg_dcs, mg_qcvar, mg_ts_auto_ice, mg_rhmini, & effr_in, tf, tcr, & microp_uniform, do_cldice, hetfrz_classnuc, & @@ -3824,7 +3822,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & end if !--- microphysical switch - Model%ncld = ncld Model%imp_physics = imp_physics !--- use effective radii in radiation, used by several microphysics options Model%effr_in = effr_in @@ -4795,7 +4792,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! Unified cloud for SHOC and/or MG3 Model%uni_cld = .false. Model%indcld = -1 -! if (Model%shoc_cld .or. Model%ncld == 2 .or. Model%ntclamt > 0) then if (Model%imp_physics == Model%imp_physics_mg) then Model%uni_cld = .true. Model%indcld = 1 @@ -4981,7 +4977,6 @@ subroutine control_print(Model) endif print *, ' ' print *, 'microphysical switch' - print *, ' ncld : ', Model%ncld print *, ' imp_physics : ', Model%imp_physics print *, ' ' @@ -6754,7 +6749,7 @@ subroutine interstitial_setup_tracers(Interstitial, Model) integer :: n, tracers !first, initialize the values (in case the values don't get initialized within if statements below) - Interstitial%nncl = Model%ncld + Interstitial%nncl = 1 Interstitial%nvdiff = Model%ntrac Interstitial%mg3_as_mg2 = .false. Interstitial%nn = Model%ntrac + 1 @@ -6765,7 +6760,6 @@ subroutine interstitial_setup_tracers(Interstitial, Model) Interstitial%otspt(:,:) = .true. Interstitial%nsamftrac = 0 Interstitial%ncstrac = 0 - Interstitial%nscav = Model%ntrac-Model%ncld+2 ! perform aerosol convective transport and PBL diffusion Interstitial%trans_aero = Model%cplchm .and. Model%trans_trac @@ -6782,12 +6776,17 @@ subroutine interstitial_setup_tracers(Interstitial, Model) Interstitial%nvdiff = Model%ntrac -3 if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 Interstitial%nncl = 5 + elseif (Model%imp_physics_zhao_carr == 99 .or. & + Model%imp_physics_zhao_carr_pdf == 98 ) then + Interstitial%nncl = 1 elseif (Model%ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount Interstitial%nvdiff = Model%ntrac - 1 endif if (Model%imp_physics == Model%imp_physics_gfdl) then Interstitial%nncl = 5 + elseif (Model%imp_physics == Model%imp_physics_fer_hires) then + Interstitial%nncl = 3 endif if (Model%imp_physics == Model%imp_physics_mg) then @@ -6805,6 +6804,9 @@ subroutine interstitial_setup_tracers(Interstitial, Model) endif endif + Interstitial%nscav = Model%ntrac-Interstitial%nncl+2 + + ! DH* STILL VALID GIVEN THE CHANGES BELOW FOR CPLCHM? if (Interstitial%nvdiff == Model%ntrac) then Interstitial%ntiwx = Model%ntiw @@ -6849,9 +6851,9 @@ subroutine interstitial_setup_tracers(Interstitial, Model) stop endif if (Interstitial%trans_aero) Interstitial%nvdiff = Interstitial%nvdiff + Model%ntchm - if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list endif + if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list Interstitial%ntkev = Interstitial%nvdiff if (Model%ntiw > 0) then diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 91a758960..1682a3e43 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2879,12 +2879,6 @@ dimensions = () type = real kind = kind_phys -[ncld] - standard_name = number_of_hydrometeors - long_name = choice of cloud scheme / number of hydrometeors - units = count - dimensions = () - type = integer [convert_dry_rho] standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air long_name = flag for converting hydrometeors from moist to dry air diff --git a/ccpp/physics b/ccpp/physics index d4fe66591..71d019c93 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d4fe665917165d72b82309d4d0dde30537d5cf2d +Subproject commit 71d019c934978921f575b8ef2e9059a3b4457775 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index f22114824..5fd516d82 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2112,7 +2112,8 @@ subroutine fv3gfs_diag_register(Diag, Time, Atm_block, Model, xlon, xlat, axes) jeco = Atm_block%jec levo = model%levs fhzero = nint(Model%fhzero) - ncld = Model%ncld +! ncld = Model%ncld + ncld = Model%imp_physics nsoil = Model%lsoil dtp = Model%dtp imp_physics = Model%imp_physics From 8f086ab135553d5025befb77f19525e8e0fa9031 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 17 May 2021 20:17:58 -0400 Subject: [PATCH 143/217] some update to typedef removing ncld --- ccpp/data/GFS_typedefs.F90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 74d820c25..2782091e6 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3067,7 +3067,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: icloud = 0 !< cloud effect to the optical depth in radiation; this also controls the cloud fraction options !< 3: with cloud effect from FA, and use cloud fraction option 3, based on Sundqvist et al. (1989) !--- M-G microphysical parameters - integer :: fprcp = 0 !< no prognostic rain and snow (MG) + integer :: fprcp = 2 !< when "0" no prognostic rain and snow (MG) + !< "1" for MG2 and "2" for MG3 integer :: pdfflag = 4 !< pdf flag for MG macro physics real(kind=kind_phys) :: mg_dcs = 200.0 !< Morrison-Gettelman microphysics parameters real(kind=kind_phys) :: mg_qcvar = 1.0 @@ -6776,8 +6777,8 @@ subroutine interstitial_setup_tracers(Interstitial, Model) Interstitial%nvdiff = Model%ntrac -3 if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 Interstitial%nncl = 5 - elseif (Model%imp_physics_zhao_carr == 99 .or. & - Model%imp_physics_zhao_carr_pdf == 98 ) then + elseif (Model%imp_physics == Model%imp_physics_zhao_carr .or. & + Model%imp_physics == Model%imp_physics_zhao_carr_pdf ) then Interstitial%nncl = 1 elseif (Model%ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount Interstitial%nvdiff = Model%ntrac - 1 @@ -6790,7 +6791,9 @@ subroutine interstitial_setup_tracers(Interstitial, Model) endif if (Model%imp_physics == Model%imp_physics_mg) then - if (abs(Model%fprcp) == 1) then + if (abs(Model%fprcp) == 0) then + Interstitial%nncl = 2 ! MG1 + elseif (abs(Model%fprcp) == 1) then Interstitial%nncl = 4 ! MG2 with rain and snow Interstitial%mg3_as_mg2 = .false. elseif (Model%fprcp >= 2) then @@ -6851,10 +6854,10 @@ subroutine interstitial_setup_tracers(Interstitial, Model) stop endif if (Interstitial%trans_aero) Interstitial%nvdiff = Interstitial%nvdiff + Model%ntchm + if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list endif - if (Model%ntke > 0) Interstitial%nvdiff = Interstitial%nvdiff + 1 ! adding tke to the list - Interstitial%ntkev = Interstitial%nvdiff + if (Model%ntke > 0) Interstitial%ntkev = Interstitial%nvdiff if (Model%ntiw > 0) then if (Model%ntclamt > 0) then From d46d238bbab4717859de4d2d1ca7ebd3149c372e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 18 May 2021 19:05:50 -0400 Subject: [PATCH 144/217] removing Interstitial%nncl and replacing Model%ncnd --- ccpp/data/GFS_typedefs.F90 | 23 +++-------------------- ccpp/data/GFS_typedefs.meta | 6 ------ ccpp/physics | 2 +- 3 files changed, 4 insertions(+), 27 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 2782091e6..0648459f9 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1884,7 +1884,6 @@ module GFS_typedefs integer :: nf_aelw !< integer :: nf_aesw !< integer :: nn !< - integer :: nncl !< integer :: nsamftrac !< integer :: nscav !< integer :: nspc1 !< @@ -4660,7 +4659,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%pdfcld = .false. Model%shcnvcw = .false. ! DH* REALLY ? - Model%ncnd = 5 + Model%ncnd = 5 !???????? need to clarify this - Moorthi Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -6254,7 +6253,7 @@ subroutine interstitial_create (Interstitial, IM, Model) ! allocate (Interstitial%otspt (Model%ntracp1,2)) ! Set up numbers of tracers for PBL, convection, etc: sets - ! Interstitial%{nncl,nvdiff,mg3_as_mg2,nn,tracers_total,ntiwx,ntk,ntkev,otspt,nsamftrac,ncstrac,nscav} + ! Interstitial%{nvdiff,mg3_as_mg2,nn,tracers_total,ntiwx,ntk,ntkev,otspt,nsamftrac,ncstrac,nscav} call interstitial_setup_tracers(Interstitial, Model) ! Allocate arrays allocate (Interstitial%adjsfculw_land (IM)) @@ -6750,7 +6749,6 @@ subroutine interstitial_setup_tracers(Interstitial, Model) integer :: n, tracers !first, initialize the values (in case the values don't get initialized within if statements below) - Interstitial%nncl = 1 Interstitial%nvdiff = Model%ntrac Interstitial%mg3_as_mg2 = .false. Interstitial%nn = Model%ntrac + 1 @@ -6772,42 +6770,27 @@ subroutine interstitial_setup_tracers(Interstitial, Model) Interstitial%nvdiff = 9 endif if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 - Interstitial%nncl = 5 elseif (Model%imp_physics == Model%imp_physics_wsm6) then Interstitial%nvdiff = Model%ntrac -3 if (Model%satmedmf) Interstitial%nvdiff = Interstitial%nvdiff + 1 - Interstitial%nncl = 5 - elseif (Model%imp_physics == Model%imp_physics_zhao_carr .or. & - Model%imp_physics == Model%imp_physics_zhao_carr_pdf ) then - Interstitial%nncl = 1 elseif (Model%ntclamt > 0) then ! for GFDL MP don't diffuse cloud amount Interstitial%nvdiff = Model%ntrac - 1 endif - if (Model%imp_physics == Model%imp_physics_gfdl) then - Interstitial%nncl = 5 - elseif (Model%imp_physics == Model%imp_physics_fer_hires) then - Interstitial%nncl = 3 - endif - if (Model%imp_physics == Model%imp_physics_mg) then if (abs(Model%fprcp) == 0) then - Interstitial%nncl = 2 ! MG1 elseif (abs(Model%fprcp) == 1) then - Interstitial%nncl = 4 ! MG2 with rain and snow Interstitial%mg3_as_mg2 = .false. elseif (Model%fprcp >= 2) then if(Model%ntgl > 0 .and. (Model%mg_do_graupel .or. Model%mg_do_hail)) then - Interstitial%nncl = 5 ! MG3 with rain and snow and grapuel/hail Interstitial%mg3_as_mg2 = .false. else ! MG3 code run without graupel/hail i.e. as MG2 - Interstitial%nncl = 4 Interstitial%mg3_as_mg2 = .true. endif endif endif - Interstitial%nscav = Model%ntrac-Interstitial%nncl+2 + Interstitial%nscav = Model%ntrac - Model%ncnd + 2 ! DH* STILL VALID GIVEN THE CHANGES BELOW FOR CPLCHM? diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 1682a3e43..598182dbb 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -9053,12 +9053,6 @@ units = count dimensions = () type = integer -[nncl] - standard_name = number_of_tracers_for_cloud_condensate - long_name = number of tracers for cloud condensate - units = count - dimensions = () - type = integer [nsamftrac] standard_name = number_of_tracers_for_samf long_name = number of tracers for scale-aware mass flux schemes diff --git a/ccpp/physics b/ccpp/physics index bc1b95830..6c912aa91 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit bc1b9583048b1ad42bcdddbca55fc64548a28c6b +Subproject commit 6c912aa910621e1a9c6429505a5f8ea990b43ec6 From ba7a460c1327094332584fde15d0458181d278ed Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 20 May 2021 08:00:31 -0400 Subject: [PATCH 145/217] defining ncnd=nwat-1 and removing some commented lines in FV3GFS_io.F90 --- ccpp/data/GFS_typedefs.F90 | 41 ++++++++++++++----------- io/FV3GFS_io.F90 | 62 ++------------------------------------ 2 files changed, 26 insertions(+), 77 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 9bb239424..4520b66c4 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -4654,12 +4654,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nqvdelt = -999 Model%nps2delt = -999 Model%npsdelt = -999 + Model%ncnd = nwat - 1 ! ncnd is the number of cloud condensate types if (Model%imp_physics == Model%imp_physics_zhao_carr) then Model%npdf3d = 0 Model%num_p3d = 4 Model%num_p2d = 3 Model%shcnvcw = .false. - Model%ncnd = 1 ! ncnd is the number of cloud condensate types +! Model%ncnd = 1 ! ncnd is the number of cloud condensate types Model%nT2delt = 1 Model%nqv2delt = 2 Model%nTdelt = 3 @@ -4676,7 +4677,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%npdf3d = 3 Model%num_p3d = 4 Model%num_p2d = 3 - Model%ncnd = 1 +! Model%ncnd = 1 if (Model%me == Model%master) print *,'Using Zhao/Carr/Sundqvist Microphysics with PDF Cloud' else if (Model%imp_physics == Model%imp_physics_fer_hires) then ! Ferrier-Aligo scheme @@ -4686,7 +4687,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%pdfcld = .false. Model%shcnvcw = .false. ! DH* REALLY ? - Model%ncnd = 5 !???????? need to clarify this - Moorthi +! Model%ncnd = 3 !???????? need to clarify this - Moorthi Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -4706,7 +4707,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !Model%num_p2d = 1 !Model%pdfcld = .false. !Model%shcnvcw = .false. - !Model%ncnd = 5 +! !Model%ncnd = 5 !Model%nleffr = 1 !Model%nieffr = 2 !Model%nseffr = 3 @@ -4718,7 +4719,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. - Model%ncnd = 5 +! Model%ncnd = 5 Model%nleffr = 1 Model%nieffr = 2 Model%nseffr = 3 @@ -4745,25 +4746,29 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. - Model%ncnd = 2 +! Model%ncnd = 2 Model%nleffr = 2 Model%nieffr = 3 Model%nreffr = 4 Model%nseffr = 5 - if (nwat /= 6) then - print *,' Morrison-Gettelman MP requires nwat to be set to 6 - job aborted' - stop - end if - if (abs(Model%fprcp) == 1) then - Model%ncnd = 4 - elseif (Model%fprcp >= 2) then - Model%ncnd = 4 - if (Model%mg_do_graupel .or. Model%mg_do_hail) then - Model%ncnd = 5 - endif + if (Model%mg_do_graupel .or. Model%mg_do_hail) then Model%num_p3d = 6 Model%ngeffr = 6 endif + if (nwat /= 6 .and. Model%fprcp >= 2) then + print *,' Morrison-Gettelman MP requires nwat to be set to 6 - job aborted' + stop + end if +! if (abs(Model%fprcp) == 1) then +! Model%ncnd = 4 +! elseif (Model%fprcp >= 2) then +! Model%ncnd = 4 +! if (Model%mg_do_graupel .or. Model%mg_do_hail) then +! Model%ncnd = 5 +! endif +! Model%num_p3d = 6 +! Model%ngeffr = 6 +! endif if (Model%me == Model%master) & print *,' Using Morrison-Gettelman double moment microphysics', & ' iaerclm=', Model%iaerclm, ' iccn=', Model%iccn, & @@ -4800,7 +4805,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%num_p2d = 1 Model%pdfcld = .false. Model%shcnvcw = .false. - Model%ncnd = 5 +! Model%ncnd = 5 if (nwat /= 6) then print *,' GFDL MP requires nwat to be set to 6 - job aborted' stop diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 5fd516d82..d99e5b25d 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -989,41 +989,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%slope(ix) = sfc_var2(i,j,30) !--- slope Sfcprop(nb)%snoalb(ix) = sfc_var2(i,j,31) !--- snoalb Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr -! if(Model%frac_grid) then - Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) - Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) - Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) -! else -! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) -! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlw(ix) -! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlw(ix) -! endif + Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) + Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) + Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) else Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif -!------------------------------------------------- -! if(Model%frac_grid) then ! obtain slmsk from landfrac -!! next 5 lines are temporary till lake model is available -! if (Sfcprop(nb)%lakefrac(ix) > zero) then -!! Sfcprop(nb)%lakefrac(ix) = nint(Sfcprop(nb)%lakefrac(ix)) -! Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) -! if (Sfcprop(nb)%lakefrac(ix) == zero) Sfcprop(nb)%fice(ix) = zero -! endif -! Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) -! if (Sfcprop(nb)%fice(ix) > Model%min_lakeice .and. Sfcprop(nb)%landfrac(ix) == zero) Sfcprop(nb)%slmsk(ix) = 2 ! land dominates ice if co-exist -! else ! obtain landfrac from slmsk -! if (Sfcprop(nb)%slmsk(ix) > 1.9_r8) then -! Sfcprop(nb)%landfrac(ix) = zero -! else -! Sfcprop(nb)%landfrac(ix) = Sfcprop(nb)%slmsk(ix) -! endif -! endif - -!------------------------------------------------- - if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) @@ -1067,7 +1041,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif else ! not a fractional grid if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then -! Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)) if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%landfrac(ix) = zero @@ -1107,35 +1080,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif -! if (Sfcprop(nb)%lakefrac(ix) > zero) then -! Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell -! if (Sfcprop(nb)%slmsk(ix) /= one) then -! if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then -! if (Sfcprop(nb)%slmsk(ix) < 1.9_r8) & -! write(*,'(a,2i3,3f6.2)') 'reset lake slmsk=2 at nb,ix=' & -! ,nb,ix,Sfcprop(nb)%fice(ix),Sfcprop(nb)%slmsk(ix),Sfcprop(nb)%lakefrac(ix) -! Sfcprop(nb)%slmsk(ix) = 2. -! else if (Sfcprop(nb)%slmsk(ix) > 1.e-7) then -! write(*,'(a,2i3,3f6.2)') 'reset lake slmsk=0 at nb,ix=' & -! ,nb,ix,Sfcprop(nb)%fice(ix),Sfcprop(nb)%slmsk(ix),Sfcprop(nb)%lakefrac(ix) -! Sfcprop(nb)%slmsk(ix) = zero -! end if -! end if -! else -! Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) -! if (Sfcprop(nb)%slmsk(ix) /= one) then -! if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then -! if (Sfcprop(nb)%slmsk(ix) < 1.9_r8) & -! write(*,'(a,2i3,3f6.2)') 'reset sea slmsk=2 at nb,ix=' & -! ,nb,ix,Sfcprop(nb)%fice(ix),Sfcprop(nb)%slmsk(ix),Sfcprop(nb)%landfrac(ix) -! Sfcprop(nb)%slmsk(ix) = 2. -! else if (Sfcprop(nb)%slmsk(ix) > 1.e-7) then -! write(*,'(a,2i3,4f6.2)') 'reset sea slmsk=0 at nb,ix=' & -! ,nb,ix,Sfcprop(nb)%fice(ix),Sfcprop(nb)%slmsk(ix),Sfcprop(nb)%landfrac(ix) -! Sfcprop(nb)%slmsk(ix) = zero -! end if -! end if -! endif ! !--- NSSTM variables if (Model%nstf_name(1) > 0) then From c3ca670d10a4d54f58f1931bf9d019b6075d6a41 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 26 May 2021 20:03:07 -0400 Subject: [PATCH 146/217] fixing restart reproducibility issue associated with updated surface cycling for fractional grid --- ccpp/data/GFS_typedefs.F90 | 2 +- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 134 +++++++++++++++++++------------------ 3 files changed, 70 insertions(+), 68 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 4520b66c4..4dd2c1786 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -4376,7 +4376,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%phour = rinc(4)/con_hr Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) - Model%kdt = 0 + Model%kdt = nint(Model%fhour*con_hr/Model%dtp) Model%first_time_step = .true. Model%restart = restart Model%hydrostatic = hydrostatic diff --git a/ccpp/physics b/ccpp/physics index a6d19441b..d642ecfa4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a6d19441b4a68b1319522abeebc0ecf47f833c91 +Subproject commit d642ecfa40b4c539339bcc8b3e001fc69059d1ff diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index d99e5b25d..758d1cecc 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -998,88 +998,90 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (Model%frac_grid) then - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 + if (.not. warm_start) then + if (Model%frac_grid) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif + endif + else + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 + endif endif endif else - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + endif endif endif endif - else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero + else ! not a fractional grid + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = one + else + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif else - if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + Sfcprop(nb)%slmsk(ix) = zero Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%oceanfrac(ix) = zero - else ! ocean + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + else ! ocean Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = one + if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif endif endif endif - else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - elseif (Sfcprop(nb)%landfrac(ix) > zero) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = one - else - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - endif - else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - Sfcprop(nb)%slmsk(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero - if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - endif - endif - endif - endif - + endif ! if (.not. warm_start) + ! !--- NSSTM variables if (Model%nstf_name(1) > 0) then From 4fa103276b6b715530931b36c8807b42fd7f5b3e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 May 2021 10:31:17 -0400 Subject: [PATCH 147/217] chaning dynamics pointer in .gitmodules --- .gitmodules | 6 +++--- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 310c4fe89..445066013 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_May042021 + 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 @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_May012021 + branch = SM_May182021 diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 2be2f3598..3720aeae5 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 2be2f3598cff435bf101f1d4e7b5389e22df2428 +Subproject commit 3720aeae54eeed54d4e8274756857542b3e5dccc diff --git a/ccpp/physics b/ccpp/physics index d642ecfa4..1fd62ea05 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d642ecfa40b4c539339bcc8b3e001fc69059d1ff +Subproject commit 1fd62ea05ebfd18d2e6875271be856670cfed08f From fa3b949b5b8f2a537869eb18fcca2f93af38827e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 May 2021 10:36:13 -0400 Subject: [PATCH 148/217] updating .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 445066013..05a2c7c6b 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/NOAA-GFDL/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework From 512b841b26e93aff19d7a0743cbd22e22f90d123 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 May 2021 11:57:30 -0400 Subject: [PATCH 149/217] update gitodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 1fd62ea05..d642ecfa4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1fd62ea05ebfd18d2e6875271be856670cfed08f +Subproject commit d642ecfa40b4c539339bcc8b3e001fc69059d1ff From 1fd8956f5f2f70e8bbcc80f55e359360c7a77b6f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 27 May 2021 14:36:00 -0400 Subject: [PATCH 150/217] putting the develop version of post files back --- io/post_gfs.F90 | 923 ++++++++++++++++++-------------------- io/post_nems_routines.F90 | 14 +- io/post_regional.F90 | 3 +- 3 files changed, 450 insertions(+), 490 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index aba1df7ff..4fb16535d 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -29,7 +29,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat, me + jend,im, nsoil, filenameflat use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -81,7 +81,6 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount - me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct @@ -113,20 +112,19 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -139,16 +137,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -245,62 +243,66 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -336,8 +338,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng + pint, exch_h, ref_10cm use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -365,11 +366,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -394,12 +395,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -478,7 +479,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -489,7 +490,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -501,10 +502,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -512,7 +513,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -520,16 +520,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -604,7 +610,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -720,19 +726,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -744,17 +750,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -766,8 +774,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -775,27 +784,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -803,14 +814,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -819,18 +830,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend ! pint(i,j,lp1)=arrayr42d(i,j) @@ -839,38 +850,38 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -879,18 +890,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -901,114 +912,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1017,8 +1028,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1027,8 +1038,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1040,8 +1051,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1053,8 +1064,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1066,8 +1077,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1079,8 +1090,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1092,8 +1103,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1105,8 +1116,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1118,8 +1129,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1132,8 +1143,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1144,8 +1155,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1159,8 +1170,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1174,8 +1185,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1190,8 +1201,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1201,8 +1212,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1212,8 +1223,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1223,8 +1234,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1234,8 +1245,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1245,8 +1256,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1256,8 +1267,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1267,8 +1278,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1278,8 +1289,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1290,8 +1301,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1302,8 +1313,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1314,8 +1325,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1327,7 +1338,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1336,8 +1347,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1346,8 +1357,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1357,8 +1368,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1367,8 +1378,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1377,8 +1388,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1387,8 +1398,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1397,8 +1408,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1407,8 +1418,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1417,8 +1428,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1428,8 +1439,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1438,8 +1449,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1448,8 +1459,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1459,8 +1470,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1470,8 +1481,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1482,8 +1493,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1493,8 +1504,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1504,30 +1515,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1536,8 +1547,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1546,8 +1557,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1556,8 +1567,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1566,30 +1577,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1599,8 +1610,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1610,8 +1621,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1624,8 +1635,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1638,8 +1649,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1649,8 +1660,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1660,8 +1671,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1670,8 +1681,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1680,8 +1691,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1690,8 +1701,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1700,8 +1711,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1710,8 +1721,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1720,8 +1731,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1730,8 +1741,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1740,8 +1751,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1750,8 +1761,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1761,8 +1772,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1771,8 +1782,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1782,8 +1793,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1792,8 +1803,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1802,8 +1813,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1812,8 +1823,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1823,8 +1834,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1833,8 +1844,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1844,8 +1855,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1854,8 +1865,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1864,8 +1875,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1874,8 +1885,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1884,8 +1895,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1894,8 +1905,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1904,8 +1915,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1914,8 +1925,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1924,8 +1935,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1934,8 +1945,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1944,8 +1955,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1954,8 +1965,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1964,8 +1975,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1975,8 +1986,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1986,8 +1997,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -1997,8 +2008,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2008,19 +2019,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2030,8 +2041,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2041,17 +2052,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2061,8 +2074,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2072,7 +2085,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2082,237 +2095,172 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP -! ------------------ - if (imp_physics == 10 .or. imp_physics == 11) then +! for GFDL MP + if (imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif ! for MG3 MP +!gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2320,12 +2268,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2333,7 +2281,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2359,33 +2308,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2393,23 +2355,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2435,13 +2396,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 - if( imp_physics == 10 .or. imp_physics == 11) then +! compute cwm for gfdlmp + if( imp_physics == 11 ) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2451,8 +2412,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2463,13 +2424,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend diff --git a/io/post_nems_routines.F90 b/io/post_nems_routines.F90 index 5f6bc73ec..4d0792284 100644 --- a/io/post_nems_routines.F90 +++ b/io/post_nems_routines.F90 @@ -19,10 +19,10 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & use vrbls2d use soil use masks, only: lmv, lmh, htm, vtm - use ctlblk_mod, only: im, jm, lm, im_jm, lp1, grib, gdsdegr, me, & - ioform, jsta, jend, jsta_m, jsta_m2, & + use ctlblk_mod, only: im, jm, lm, im_jm, lp1, grib, gdsdegr, me, & + ioform, jsta, jend, jsta_m, jsta_m2, & jend_m, jend_m2, jvend_2u, jsta_2l, jend_2u, iup, idn, & - icnt, idsp, mpi_comm_comp, num_servers, & + icnt, idsp, mpi_comm_comp, num_servers, & num_procs ! !----------------------------------------------------------------------- @@ -58,7 +58,7 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! set ndegr gdsdegr = 1000000. IOFORM = 'grib' -! me = mype-lead_write + me = mype-lead_write last_write_task = lead_write+nwtlpes-1 mpi_comm_comp = mpicomp num_procs = nwtlpes @@ -162,7 +162,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) !--- character (len=*), intent(in) :: post_namelist integer :: kpo,kth,kpv,nlunit - real :: untcnvt + real :: untcnvt logical :: popascal real,dimension(komax) :: po,th,pv namelist/nampgb/kpo,po,kth,th,kpv,pv,popascal,d3d_on,gocart_on, & @@ -199,7 +199,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) endif 119 continue if (me == 0) then - print*,'komax,iret for nampgb= ',komax,iret,' me=',me + print*,'komax,iret for nampgb= ',komax,iret print*,'komax,kpo,kth,th,kpv,pv,popascal== ',komax,kpo & & ,kth,th(1:kth),kpv,pv(1:kpv),popascal,' gocart_on=',gocart_on endif @@ -238,7 +238,7 @@ subroutine read_postnmlt(kpo,kth,kpv,po,th,pv,nlunit,post_namelist) lsmp1 = lsm + 1 pthresh = 0.000001 if (me==0) print*,'LSM, SPL = ',lsm,spl(1:lsm),' pthresh=', & - pthresh,' me=',me + pthresh ! ! set default novegtype for GFS, need to get this variable from gfs physics novegtype = 20 diff --git a/io/post_regional.F90 b/io/post_regional.F90 index 3d8877b37..34c6ffcd5 100644 --- a/io/post_regional.F90 +++ b/io/post_regional.F90 @@ -33,7 +33,7 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat, me + jend,im, nsoil, filenameflat use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl @@ -85,7 +85,6 @@ subroutine post_run_regional(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount - me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct From 242af1eb98f5d424b58fefee83cd65477d2c29c0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 30 May 2021 16:22:41 -0400 Subject: [PATCH 151/217] fixing a bug in FV3GFS_io.F90 --- io/FV3GFS_io.F90 | 136 ++++++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 67 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index d88ea57de..f5870cc95 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1050,89 +1050,91 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (.not. warm_start) then - if (Model%frac_grid) then - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif - endif - else - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif + if (Model%frac_grid) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then - Sfcprop(nb)%landfrac(ix) = zero - if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero - else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - endif + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 endif endif endif - else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - elseif (Sfcprop(nb)%landfrac(ix) > zero) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = one - else - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%oceanfrac(ix) = zero - if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - else ! ocean + else ! ocean Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = one - if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif endif endif endif - endif ! if (.not. warm_start) + else ! not a fractional grid + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = one + else + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + Sfcprop(nb)%slmsk(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + endif + endif + endif + + if (warm_start) then + Sfcprop(nb)%slmsk(ix) = sfc_var2(i,j,1) !--- slmsk + endif ! !--- NSSTM variables From 7f29862ccda75e1750b09112a488c48bdf3056a1 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 30 May 2021 17:43:28 -0400 Subject: [PATCH 152/217] fixing an erro in FV3GFS_io.F90 --- io/FV3GFS_io.F90 | 136 ++++++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 67 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 758d1cecc..71dd152ab 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -998,89 +998,91 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (.not. warm_start) then - if (Model%frac_grid) then - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif - endif - else - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) - if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then - Sfcprop(nb)%slmsk(ix) = 2 - else - Sfcprop(nb)%slmsk(ix) = 0 - endif + if (Model%frac_grid) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then - Sfcprop(nb)%landfrac(ix) = zero - if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero - else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - endif + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%slmsk(ix) = 2 + else + Sfcprop(nb)%slmsk(ix) = 0 endif endif endif - else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - elseif (Sfcprop(nb)%landfrac(ix) > zero) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = one - else - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 - endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - else - Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%oceanfrac(ix) = zero - if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - else ! ocean + else ! ocean Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = one - if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif endif endif endif - endif ! if (.not. warm_start) + else ! not a fractional grid + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = one + else + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + else + if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + else + Sfcprop(nb)%slmsk(ix) = zero + Sfcprop(nb)%landfrac(ix) = zero + if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes + Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = zero + if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 + else ! ocean + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one + if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + endif + endif + endif + endif + + if (warm_start) then + Sfcprop(nb)%slmsk(ix) = sfc_var2(i,j,1) !--- slmsk + endif ! !--- NSSTM variables From 4a3b48f12fed6c6fca8dd12e2b483917a149dbf3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 31 May 2021 19:40:26 -0400 Subject: [PATCH 153/217] adding snodi --- ccpp/data/GFS_typedefs.F90 | 27 +++++++++++++----------- ccpp/data/GFS_typedefs.meta | 28 +++++++------------------ ccpp/framework | 2 +- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 42 ++++++++++++++++++++++++++++--------- 5 files changed, 56 insertions(+), 45 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 4dd2c1786..a5b058c8b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -237,6 +237,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: zorli (:) => null() !< ice surface roughness in cm real (kind=kind_phys), pointer :: zorlwav(:) => null() !< wave surface roughness in cm derived from wave model real (kind=kind_phys), pointer :: fice (:) => null() !< ice fraction over open water grid + real (kind=kind_phys), pointer :: snodi (:) => null() !< snow depth over sea/lake ice ! real (kind=kind_phys), pointer :: hprim (:) => null() !< topographic standard deviation in m real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m @@ -1951,10 +1952,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smcmax(:) => null() !< real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< - real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< +! real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< real (kind=kind_phys), pointer :: snowd_land(:) => null() !< real (kind=kind_phys), pointer :: snowd_land_save(:) => null() !< - real (kind=kind_phys), pointer :: snowd_water(:) => null() !< +! real (kind=kind_phys), pointer :: snowd_water(:) => null() !< real (kind=kind_phys), pointer :: snow_depth(:) => null() !< real (kind=kind_phys), pointer :: snohf(:) => null() !< real (kind=kind_phys), pointer :: snohf_snow(:) => null() !< @@ -2006,7 +2007,7 @@ module GFS_typedefs integer, pointer :: vegtype(:) => null() !< real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< real (kind=kind_phys), pointer :: wcbmax(:) => null() !< - real (kind=kind_phys), pointer :: weasd_water(:) => null() !< +! real (kind=kind_phys), pointer :: weasd_water(:) => null() !< real (kind=kind_phys), pointer :: weasd_land(:) => null() !< real (kind=kind_phys), pointer :: weasd_land_save(:) => null() !< real (kind=kind_phys), pointer :: weasd_ice(:) => null() !< @@ -2281,6 +2282,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%zorli (IM)) allocate (Sfcprop%zorlwav (IM)) allocate (Sfcprop%fice (IM)) + allocate (Sfcprop%snodi (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) @@ -2301,6 +2303,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%zorli = clear_val Sfcprop%zorlwav = clear_val Sfcprop%fice = clear_val + Sfcprop%snodi = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val @@ -6483,9 +6486,9 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%sigmatot (IM,Model%levs)) allocate (Interstitial%slopetype (IM)) allocate (Interstitial%snowc (IM)) - allocate (Interstitial%snowd_ice (IM)) +! allocate (Interstitial%snowd_ice (IM)) allocate (Interstitial%snowd_land (IM)) - allocate (Interstitial%snowd_water (IM)) +! allocate (Interstitial%snowd_water (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) allocate (Interstitial%soiltype (IM)) @@ -6521,7 +6524,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%wcbmax (IM)) allocate (Interstitial%weasd_ice (IM)) allocate (Interstitial%weasd_land (IM)) - allocate (Interstitial%weasd_water (IM)) +! allocate (Interstitial%weasd_water (IM)) allocate (Interstitial%wind (IM)) allocate (Interstitial%work1 (IM)) allocate (Interstitial%work2 (IM)) @@ -7222,9 +7225,9 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%sigmatot = clear_val Interstitial%slopetype = 0 Interstitial%snowc = clear_val - Interstitial%snowd_ice = huge +! Interstitial%snowd_ice = huge Interstitial%snowd_land = huge - Interstitial%snowd_water = huge +! Interstitial%snowd_water = huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val Interstitial%soiltype = 0 @@ -7257,7 +7260,7 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%wcbmax = clear_val Interstitial%weasd_ice = huge Interstitial%weasd_land = huge - Interstitial%weasd_water = huge +! Interstitial%weasd_water = huge Interstitial%wind = huge Interstitial%work1 = clear_val Interstitial%work2 = clear_val @@ -7601,9 +7604,9 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%sigmatot ) = ', sum(Interstitial%sigmatot ) write (0,*) 'sum(Interstitial%slopetype ) = ', sum(Interstitial%slopetype ) write (0,*) 'sum(Interstitial%snowc ) = ', sum(Interstitial%snowc ) - write (0,*) 'sum(Interstitial%snowd_ice ) = ', sum(Interstitial%snowd_ice ) +! write (0,*) 'sum(Interstitial%snowd_ice ) = ', sum(Interstitial%snowd_ice ) write (0,*) 'sum(Interstitial%snowd_land ) = ', sum(Interstitial%snowd_land ) - write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) +! write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) write (0,*) 'sum(Interstitial%snohf ) = ', sum(Interstitial%snohf ) write (0,*) 'sum(Interstitial%snowmt ) = ', sum(Interstitial%snowmt ) write (0,*) 'sum(Interstitial%soiltype ) = ', sum(Interstitial%soiltype ) @@ -7639,7 +7642,7 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%wcbmax ) = ', sum(Interstitial%wcbmax ) write (0,*) 'sum(Interstitial%weasd_ice ) = ', sum(Interstitial%weasd_ice ) write (0,*) 'sum(Interstitial%weasd_land ) = ', sum(Interstitial%weasd_land ) - write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) +! write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) write (0,*) 'sum(Interstitial%wind ) = ', sum(Interstitial%wind ) write (0,*) 'sum(Interstitial%work1 ) = ', sum(Interstitial%work1 ) write (0,*) 'sum(Interstitial%work2 ) = ', sum(Interstitial%work2 ) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 95d3d1cf2..c37eddb75 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -578,6 +578,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[snodi] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hprime] standard_name = statistical_measures_of_subgrid_orography long_name = orographic metrics @@ -9565,13 +9572,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[snowd_water] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [snowd_land] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land @@ -9587,13 +9587,6 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snowd_ice] - standard_name = surface_snow_thickness_water_equivalent_over_ice - long_name = water equivalent snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [snow_depth] standard_name = actual_snow_depth long_name = actual snow depth @@ -9950,13 +9943,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[weasd_water] - standard_name = water_equivalent_accumulated_snow_depth_over_water - long_name = water equiv of acc snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [weasd_land] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land diff --git a/ccpp/framework b/ccpp/framework index 7f8edebdc..54b158f91 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 7f8edebdc9dc593db082d9a991473229f3cd9c58 +Subproject commit 54b158f91fb0abf58ab099d4ae80a57d7f1ee0b8 diff --git a/ccpp/physics b/ccpp/physics index d642ecfa4..941ff1d6e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d642ecfa40b4c539339bcc8b3e001fc69059d1ff +Subproject commit 941ff1d6ef7cf171588a6f325226f8d9ebcd2f6a diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 71dd152ab..5d1fb0f84 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -600,7 +600,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo ! if (Model%frac_grid) then ! needs more variables - nvar_s2m = 35 +! nvar_s2m = 35 + nvar_s2m = 36 ! else ! nvar_s2m = 32 ! endif @@ -757,7 +758,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! if(Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell - sfc_name2(35) = 'zorli' !zorl on land portion of a cell + sfc_name2(35) = 'zorli' !zorl on ice portion of a cell + sfc_name2(36) = 'snodi' !weasd on ice portion of a cell ! endif if(Model%cplwav) then sfc_name2(nvar_s2m) = 'zorlwav' !zorl on land portion of a cell @@ -841,8 +843,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & - .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav') then + if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & + .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & + .or. trim(sfc_name2(num)) == 'snodi') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -991,7 +994,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) - Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) + Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorli (zorl on ice portion of a cell) + Sfcprop(nb)%snodi(ix) = sfc_var2(i,j,36) !--- snodi (weasd on ice portion of a cell) if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) else @@ -1083,7 +1087,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (warm_start) then Sfcprop(nb)%slmsk(ix) = sfc_var2(i,j,1) !--- slmsk endif - + ! !--- NSSTM variables if (Model%nstf_name(1) > 0) then @@ -1278,6 +1282,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif + if (sfc_var2(i,j,36) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') +!$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > min(Model%min_seaice,Model%min_lakeice)) then + Sfcprop(nb)%snodi(ix) = Sfcprop(nb)%snowd(ix) / Sfcprop(nb)%fice(ix) !--- use snowd over ice and zero over water/land + else + Sfcprop(nb)%snodi(ix) = zero + endif + enddo + enddo + endif + if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') !$omp parallel do default(shared) private(nb, ix) @@ -1393,7 +1411,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() ! if (Model%frac_grid) then ! needs more variables - nvar2m = 35 +! nvar2m = 35 + nvar2m = 36 ! else ! nvar2m = 32 ! endif @@ -1501,7 +1520,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! if (Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell - sfc_name2(35) = 'zorli' !zorl on land portion of a cell + sfc_name2(35) = 'zorli' !zorl on ice portion of a cell + sfc_name2(36) = 'snodi' !weasd on land portion of a cell ! endif if (Model%cplwav) then sfc_name2(nvar2m) = 'zorlwav' !zorl on land portion of a cell @@ -1575,8 +1595,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' & - .or.trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav') then + if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' & + .or.trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & + .or.trim(sfc_name2(num)) == 'snodi') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -1707,6 +1728,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) + sfc_var2(i,j,36) = Sfcprop(nb)%snodi(ix) !--- snodi (weasd on ice) ! endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) From 7f5a7ef9768b97a0c195a60661b528b6fa68f67e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 8 Jun 2021 19:21:48 +0000 Subject: [PATCH 154/217] adding snow depth and weasd over land to SfcProps and fixing some issues associated with fractional grid and some threading error in FV3GFS_io that made such a headache to find it --- atmos_model.F90 | 10 +- ccpp/data/GFS_typedefs.F90 | 38 +++--- ccpp/data/GFS_typedefs.meta | 48 +++----- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 234 +++++++++++++++++++----------------- 5 files changed, 174 insertions(+), 158 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index e327b13c1..b06663eb9 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1540,6 +1540,10 @@ subroutine assign_importdata(rc) real(kind=GFS_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm) +! + real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed +! real(kind=GFS_kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required + real(kind=GFS_kind_phys), parameter :: hsmax = 2.0 !< maximum snow depth allowed ! !------------------------------------------------------------------------------ ! @@ -1839,7 +1843,7 @@ subroutine assign_importdata(rc) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then ! GFS_data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j) - GFS_data(nb)%Sfcprop%hice(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%hice(ix) = min(datar8(i,j), himax) endif enddo enddo @@ -2262,8 +2266,8 @@ subroutine assign_importdata(rc) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then if (GFS_data(nb)%Sfcprop%fice(ix) >= GFS_control%min_seaice) then - GFS_data(nb)%Coupling%hsnoin_cpl(ix) = GFS_data(nb)%Coupling%hsnoin_cpl(ix) & - / GFS_data(nb)%Sfcprop%fice(ix) + GFS_data(nb)%Coupling%hsnoin_cpl(ix) = min(hsmax, GFS_data(nb)%Coupling%hsnoin_cpl(ix) & + / (GFS_data(nb)%Sfcprop%fice(ix)*GFS_data(nb)%Sfcprop%oceanfrac(ix))) GFS_data(nb)%Sfcprop%zorli(ix) = z0ice else GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Sfcprop%tsfco(ix) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index b4e2d35d9..5ec2c0f62 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -237,6 +237,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: zorli (:) => null() !< ice surface roughness in cm real (kind=kind_phys), pointer :: zorlwav(:) => null() !< wave surface roughness in cm derived from wave model real (kind=kind_phys), pointer :: fice (:) => null() !< ice fraction over open water grid + real (kind=kind_phys), pointer :: snodl (:) => null() !< snow depth over land + real (kind=kind_phys), pointer :: weasdl (:) => null() !< weasds over land ! real (kind=kind_phys), pointer :: hprim (:) => null() !< topographic standard deviation in m real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m @@ -1964,9 +1966,9 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< - real (kind=kind_phys), pointer :: snowd_land(:) => null() !< +! real (kind=kind_phys), pointer :: snowd_land(:) => null() !< real (kind=kind_phys), pointer :: snowd_land_save(:) => null() !< - real (kind=kind_phys), pointer :: snowd_water(:) => null() !< +! real (kind=kind_phys), pointer :: snowd_water(:) => null() !< real (kind=kind_phys), pointer :: snow_depth(:) => null() !< real (kind=kind_phys), pointer :: snohf(:) => null() !< real (kind=kind_phys), pointer :: snohf_snow(:) => null() !< @@ -2017,8 +2019,8 @@ module GFS_typedefs integer, pointer :: vegtype(:) => null() !< real (kind=kind_phys), pointer :: w_upi(:,:) => null() !< real (kind=kind_phys), pointer :: wcbmax(:) => null() !< - real (kind=kind_phys), pointer :: weasd_water(:) => null() !< - real (kind=kind_phys), pointer :: weasd_land(:) => null() !< +! real (kind=kind_phys), pointer :: weasd_water(:) => null() !< +! real (kind=kind_phys), pointer :: weasd_land(:) => null() !< real (kind=kind_phys), pointer :: weasd_land_save(:) => null() !< real (kind=kind_phys), pointer :: weasd_ice(:) => null() !< real (kind=kind_phys), pointer :: wind(:) => null() !< @@ -2295,6 +2297,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%zorli (IM)) allocate (Sfcprop%zorlwav (IM)) allocate (Sfcprop%fice (IM)) + allocate (Sfcprop%snodl (IM)) + allocate (Sfcprop%weasdl (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) allocate (Sfcprop%emis_lnd (IM)) @@ -2316,6 +2320,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%zorli = clear_val Sfcprop%zorlwav = clear_val Sfcprop%fice = clear_val + Sfcprop%snodl = clear_val + Sfcprop%weasdl = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val Sfcprop%emis_lnd = clear_val @@ -6530,8 +6536,8 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%slopetype (IM)) allocate (Interstitial%snowc (IM)) allocate (Interstitial%snowd_ice (IM)) - allocate (Interstitial%snowd_land (IM)) - allocate (Interstitial%snowd_water (IM)) +! allocate (Interstitial%snowd_land (IM)) +! allocate (Interstitial%snowd_water (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) allocate (Interstitial%soiltype (IM)) @@ -6565,8 +6571,8 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%vegtype (IM)) allocate (Interstitial%wcbmax (IM)) allocate (Interstitial%weasd_ice (IM)) - allocate (Interstitial%weasd_land (IM)) - allocate (Interstitial%weasd_water (IM)) +! allocate (Interstitial%weasd_land (IM)) +! allocate (Interstitial%weasd_water (IM)) allocate (Interstitial%wind (IM)) allocate (Interstitial%work1 (IM)) allocate (Interstitial%work2 (IM)) @@ -7271,8 +7277,8 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%slopetype = 0 Interstitial%snowc = clear_val Interstitial%snowd_ice = huge - Interstitial%snowd_land = huge - Interstitial%snowd_water = huge +! Interstitial%snowd_land = huge +! Interstitial%snowd_water = huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val Interstitial%soiltype = 0 @@ -7303,8 +7309,8 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%vegtype = 0 Interstitial%wcbmax = clear_val Interstitial%weasd_ice = huge - Interstitial%weasd_land = huge - Interstitial%weasd_water = huge +! Interstitial%weasd_land = huge +! Interstitial%weasd_water = huge Interstitial%wind = huge Interstitial%work1 = clear_val Interstitial%work2 = clear_val @@ -7654,8 +7660,8 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%slopetype ) = ', sum(Interstitial%slopetype ) write (0,*) 'sum(Interstitial%snowc ) = ', sum(Interstitial%snowc ) write (0,*) 'sum(Interstitial%snowd_ice ) = ', sum(Interstitial%snowd_ice ) - write (0,*) 'sum(Interstitial%snowd_land ) = ', sum(Interstitial%snowd_land ) - write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) +! write (0,*) 'sum(Interstitial%snowd_land ) = ', sum(Interstitial%snowd_land ) +! write (0,*) 'sum(Interstitial%snowd_water ) = ', sum(Interstitial%snowd_water ) write (0,*) 'sum(Interstitial%snohf ) = ', sum(Interstitial%snohf ) write (0,*) 'sum(Interstitial%snowmt ) = ', sum(Interstitial%snowmt ) write (0,*) 'sum(Interstitial%soiltype ) = ', sum(Interstitial%soiltype ) @@ -7689,8 +7695,8 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%vegtype ) = ', sum(Interstitial%vegtype ) write (0,*) 'sum(Interstitial%wcbmax ) = ', sum(Interstitial%wcbmax ) write (0,*) 'sum(Interstitial%weasd_ice ) = ', sum(Interstitial%weasd_ice ) - write (0,*) 'sum(Interstitial%weasd_land ) = ', sum(Interstitial%weasd_land ) - write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) +! write (0,*) 'sum(Interstitial%weasd_land ) = ', sum(Interstitial%weasd_land ) +! write (0,*) 'sum(Interstitial%weasd_water ) = ', sum(Interstitial%weasd_water ) write (0,*) 'sum(Interstitial%wind ) = ', sum(Interstitial%wind ) write (0,*) 'sum(Interstitial%work1 ) = ', sum(Interstitial%work1 ) write (0,*) 'sum(Interstitial%work2 ) = ', sum(Interstitial%work2 ) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 2ef720f55..e330e8d3a 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -578,6 +578,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[snodl] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdl] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hprime] standard_name = statistical_measures_of_subgrid_orography long_name = orographic metrics @@ -9642,16 +9656,9 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[snowd_water] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snowd_land] - standard_name = surface_snow_thickness_water_equivalent_over_land - long_name = water equivalent snow depth over land +[snowd_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice units = mm dimensions = (horizontal_loop_extent) type = real @@ -9664,13 +9671,6 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snowd_ice] - standard_name = surface_snow_thickness_water_equivalent_over_ice - long_name = water equivalent snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [snow_depth] standard_name = actual_snow_depth long_name = actual snow depth @@ -10020,20 +10020,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[weasd_water] - standard_name = water_equivalent_accumulated_snow_depth_over_water - long_name = water equiv of acc snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[weasd_land] - standard_name = water_equivalent_accumulated_snow_depth_over_land - long_name = water equiv of acc snow depth over land - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [weasd_land_save] standard_name = water_equivalent_accumulated_snow_depth_over_land_save long_name = water equiv of acc snow depth over land before entering a physics scheme diff --git a/ccpp/physics b/ccpp/physics index 941ff1d6e..466d4b4d0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 941ff1d6ef7cf171588a6f325226f8d9ebcd2f6a +Subproject commit 466d4b4d034b8a57fed906219bea1be80c7fe38e diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index f5870cc95..dc2731705 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2,14 +2,14 @@ module FV3GFS_io_mod !----------------------------------------------------------------------- ! gfs_physics_driver_mod defines the GFS physics routines used by -! the GFDL FMS system to obtain tendencies and boundary fluxes due +! the GFDL FMS system to obtain tendencies and boundary fluxes due ! to the physical parameterizations and processes that drive ! atmospheric time tendencies for use by other components, namely ! the atmospheric dynamical core. ! ! NOTE: This module currently supports only the operational GFS ! parameterizations as of September 2015. Further development -! is needed to support the full suite of physical +! is needed to support the full suite of physical ! parameterizations present in the GFS physics package. !----------------------------------------------------------------------- ! @@ -488,7 +488,7 @@ end subroutine FV3GFS_GFS_checksum ! ! opens: oro_data.tile?.nc, sfc_data.tile?.nc ! -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_start) !--- interface variable definitions type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) @@ -633,11 +633,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo -! if (Model%frac_grid) then ! needs more variables - nvar_s2m = 37 -! else -! nvar_s2m = 32 -! endif + nvar_s2m = 39 if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif @@ -726,7 +722,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call free_restart_type(Oro_ls_restart) call free_restart_type(Oro_ss_restart) - end if + endif !--- SURFACE FILE if (.not. allocated(sfc_name2)) then @@ -788,13 +784,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(31) = 'snoalb' !--- variables below here are optional sfc_name2(32) = 'sncovr' -! if(Model%frac_grid) then - sfc_name2(33) = 'tsfcl' !temp on land portion of a cell - sfc_name2(34) = 'zorll' !zorl on land portion of a cell - sfc_name2(35) = 'zorli' !zorl on land portion of a cell - sfc_name2(36) = 'tsfc' !tsfc composite - sfc_name2(37) = 'zorl' !zorl composite -! endif + sfc_name2(33) = 'tsfcl' !temp on land portion of a cell + sfc_name2(34) = 'zorll' !zorl on land portion of a cell + sfc_name2(35) = 'zorli' !zorl on ice portion of a cell + sfc_name2(36) = 'snodl' !snowd on land portion of a cell + sfc_name2(37) = 'tsfc' !tsfc composite + sfc_name2(38) = 'zorl' !zorl composite + sfc_name2(39) = 'weasdl'!weasd on land portion of a cell if(Model%cplwav) then sfc_name2(nvar_s2m) = 'zorlwav' !zorl on land portion of a cell endif @@ -890,8 +886,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & + if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & + .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorl') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else @@ -951,11 +948,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif !--- register the 3D fields -! if (Model%frac_grid) then - sfc_name3(0) = 'tiice' - var3_p => sfc_var3ice(:,:,:) - id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.) -! end if + sfc_name3(0) = 'tiice' + var3_p => sfc_var3ice(:,:,:) + id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name3(0), var3_p, domain=fv_domain, mandatory=.false.) do num = 1,nvar_s3 var3_p => sfc_var3(:,:,:,num) @@ -1041,9 +1036,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sncovr(ix) = sfc_var2(i,j,32) !--- sncovr Sfcprop(nb)%tsfcl(ix) = sfc_var2(i,j,33) !--- sfcl (temp on land portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,34) !--- zorll (zorl on land portion of a cell) - Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorll (zorl on ice portion of a cell) - Sfcprop(nb)%tsfc(ix) = sfc_var2(i,j,36) !--- tsfc composite - Sfcprop(nb)%zorl(ix) = sfc_var2(i,j,37) !--- zorl composite + Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,35) !--- zorli (zorl on ice portion of a cell) + Sfcprop(nb)%snodl(ix) = sfc_var2(i,j,36) !--- snodl (snowd on land portion of a cell) + Sfcprop(nb)%tsfc(ix) = sfc_var2(i,j,37) !--- tsfc composite + Sfcprop(nb)%zorl(ix) = sfc_var2(i,j,38) !--- zorl composite + Sfcprop(nb)%weasdl(ix) = sfc_var2(i,j,39) !--- weasdl (weasd on land portion of a cell) if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) else @@ -1074,6 +1071,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif else + Model%frac_grid = .false. if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero @@ -1311,86 +1309,102 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta j = Atm_block%index(1)%jj(1) - jsc + 1 -! if (Model%frac_grid) then - if (sfc_var2(i,j,33) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') + if (sfc_var2(i,j,33) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tsfcl') !$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) !--- compute tsfcl from existing variables - enddo + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix) !--- compute tsfcl from existing variables enddo - endif + enddo + endif - if (sfc_var2(i,j,34) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') + if (sfc_var2(i,j,34) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') !$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorll from existing variables - enddo + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorll from existing variables enddo - endif + enddo + endif - if (sfc_var2(i,j,35) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') + if (sfc_var2(i,j,35) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorli') !$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorli from existing variables - enddo + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorli from existing variables enddo - endif + enddo + endif + + if (sfc_var2(i,j,36) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - using snowd') +!$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%landfrac(ix) > zero) then + tem = one / Sfcprop(nb)%landfrac(ix) + Sfcprop(nb)%snodl(ix) = Sfcprop(nb)%snowd(ix) * tem + Sfcprop(nb)%weasdl(ix) = Sfcprop(nb)%weasd(ix) * tem + else + Sfcprop(nb)%snodl(ix) = zero + Sfcprop(nb)%weasdl(ix) = zero + endif + enddo + enddo + endif ! Fill in composite tsfc and zorl for coldstart runs - compute_tsfc_zorl_for_colstart: if (.not. warm_start) then - if(Model%frac_grid) then ! 3-way composite - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing composite tsfc and zorl') -!$omp parallel do default(shared) private(nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) ! this may break restart reproducibility - tem1 = one - Sfcprop(nb)%landfrac(ix) - tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%zorli(ix) * tem & - + Sfcprop(nb)%zorlw(ix) * (tem1-tem) - - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & - + Sfcprop(nb)%tisfc(ix) * tem & - + Sfcprop(nb)%tsfco(ix) * (tem1-tem) - enddo + compute_tsfc_zorl_for_colstart: if (.not. warm_start) then + if(Model%frac_grid) then ! 3-way composite + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing composite tsfc and zorl') +!$omp parallel do default(shared) private(nb, ix, tem, tem1) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) ! this may break restart reproducibility + tem1 = one - Sfcprop(nb)%landfrac(ix) + tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) * Sfcprop(nb)%landfrac(ix) & + + Sfcprop(nb)%zorli(ix) * tem & + + Sfcprop(nb)%zorlw(ix) * (tem1-tem) + + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & + + Sfcprop(nb)%tisfc(ix) * tem & + + Sfcprop(nb)%tsfco(ix) * (tem1-tem) enddo - else + enddo + else !$omp parallel do default(shared) private(nb, ix, tem) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlw - if (Sfcprop(nb)%slmsk(ix) == 1) then - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) - else - tem = one - Sfcprop(nb)%fice(ix) - Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & - + Sfcprop(nb)%zorlw(ix) * tem - Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & - + Sfcprop(nb)%tsfco(ix) * tem - endif - enddo - enddo - endif - endif compute_tsfc_zorl_for_colstart - - if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then - if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') -!$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorlwav from existing variables + !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlw + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + else + tem = one - Sfcprop(nb)%fice(ix) + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%zorlw(ix) * tem + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) & + + Sfcprop(nb)%tsfco(ix) * tem + endif enddo enddo endif + endif compute_tsfc_zorl_for_colstart + + if (sfc_var2(i,j,nvar_s2m) < -9990.0_r8) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') +!$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) !--- compute zorlwav from existing variables + enddo + enddo + endif if (nint(sfc_var3ice(1,1,1)) == -9999) then !--- initialize internal ice temp from layer 1 and 2 soil temp if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing tiice') @@ -1437,7 +1451,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p3 => NULL() ! if (Model%frac_grid) then ! needs more variables - nvar2m = 37 + nvar2m = 39 ! else ! nvar2m = 32 ! endif @@ -1545,9 +1559,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! if (Model%frac_grid) then sfc_name2(33) = 'tsfcl' !temp on land portion of a cell sfc_name2(34) = 'zorll' !zorl on land portion of a cell - sfc_name2(35) = 'zorli' !zorl on land portion of a cell - sfc_name2(36) = 'tsfc' !tsfc composite - sfc_name2(37) = 'zorl' !zorl composite + sfc_name2(35) = 'zorli' !zorl on ice portion of a cell + sfc_name2(36) = 'snodl' !snowd on land portion of a cell + sfc_name2(37) = 'tsfc' !tsfc composite + sfc_name2(38) = 'zorl' !zorl composite + sfc_name2(39) = 'weasd' !weasd on land portion of a cell ! endif if (Model%cplwav) then sfc_name2(nvar2m) = 'zorlwav' !zorl on land portion of a cell @@ -1634,8 +1650,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) - if (trim(sfc_name2(num)) == 'sncovr'.or.trim(sfc_name2(num)) == 'tsfcl'.or.trim(sfc_name2(num)) == 'zorll' & - .or.trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav') then + if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & + .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & + .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorl') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain) @@ -1763,11 +1781,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix)!--- sncovr ! if (Model%frac_grid) then - sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) - sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) - sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) - sfc_var2(i,j,36) = Sfcprop(nb)%tsfc(ix) !--- tsfc composite - sfc_var2(i,j,37) = Sfcprop(nb)%zorl(ix) !--- zorl composite + sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) + sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) + sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) + sfc_var2(i,j,36) = Sfcprop(nb)%snodl(ix) !--- snodl (snowd on ice) + sfc_var2(i,j,37) = Sfcprop(nb)%tsfc(ix) !--- tsfc composite + sfc_var2(i,j,38) = Sfcprop(nb)%zorl(ix) !--- zorl composite + sfc_var2(i,j,39) = Sfcprop(nb)%weasdl(ix) !--- weasdl (weasd on ice) ! endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) @@ -1915,7 +1935,7 @@ end subroutine sfc_prop_restart_write ! ! opens: phys_data.tile?.nc ! -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine phys_restart_read (GFS_Restart, Atm_block, Model, fv_domain) !--- interface variable definitions type(GFS_restart_type), intent(in) :: GFS_Restart @@ -2026,7 +2046,7 @@ end subroutine phys_restart_read ! restarts. ! ! calls: register_restart_field, save_restart -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timestamp) !--- interface variable definitions type(GFS_restart_type), intent(in) :: GFS_Restart @@ -2448,42 +2468,42 @@ subroutine fv3gfs_diag_output(time, diag, atm_block, nx, ny, levs, ntcw, ntoz, & var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%tgrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gt0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif !--- horizontal wind component tendency if (trim(Diag(idx)%name) == 'du_dt') then var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%ugrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gu0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif !--- meridional wind component tendency if (trim(Diag(idx)%name) == 'dv_dt') then var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%vgrs(1:ngptc,levs:1:-1), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gv0(1:ngptc,levs:1:-1), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif !--- specific humidity tendency if (trim(Diag(idx)%name) == 'dsphum_dt') then var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,1:1), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,1:1), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif !--- cloud water mixing ration tendency if (trim(Diag(idx)%name) == 'dclwmr_dt') then var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,ntcw:ntcw), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,ntcw:ntcw), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif !--- ozone mixing ration tendency if (trim(Diag(idx)%name) == 'do3mr_dt') then var3(1:nx,1:ny,1:levs) = RESHAPE(Statein%qgrs(1:ngptc,levs:1:-1,ntoz:ntoz), (/nx,ny,levs/)) var3(1:nx,1:ny,1:levs) = (RESHAPE(Stateout%gq0(1:ngptc,levs:1:-1,ntoz:ntoz), (/nx,ny,levs/)) & - var3(1:nx,1:ny,1:levs))*rdt - used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) + used=send_data(Diag(idx)%id, var3, Time, is_in=is_in, js_in=js_in, ks_in=1) endif #endif endif @@ -3159,6 +3179,6 @@ subroutine find_output_name(module_name,field_name,output_name) end subroutine find_output_name #endif -!------------------------------------------------------------------------- +!------------------------------------------------------------------------- end module FV3GFS_io_mod From d0a333df6b609fa107ac84c7d259a4fa68239047 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 9 Jun 2021 00:17:21 +0000 Subject: [PATCH 155/217] some cosmetic update --- io/FV3GFS_io.F90 | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index dc2731705..968289297 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1780,15 +1780,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,30) = Sfcprop(nb)%slope(ix) !--- slope sfc_var2(i,j,31) = Sfcprop(nb)%snoalb(ix)!--- snoalb sfc_var2(i,j,32) = Sfcprop(nb)%sncovr(ix)!--- sncovr -! if (Model%frac_grid) then - sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) - sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) - sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) - sfc_var2(i,j,36) = Sfcprop(nb)%snodl(ix) !--- snodl (snowd on ice) - sfc_var2(i,j,37) = Sfcprop(nb)%tsfc(ix) !--- tsfc composite - sfc_var2(i,j,38) = Sfcprop(nb)%zorl(ix) !--- zorl composite - sfc_var2(i,j,39) = Sfcprop(nb)%weasdl(ix) !--- weasdl (weasd on ice) -! endif + sfc_var2(i,j,33) = Sfcprop(nb)%tsfcl(ix) !--- tsfcl (temp on land) + sfc_var2(i,j,34) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) + sfc_var2(i,j,35) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) + sfc_var2(i,j,36) = Sfcprop(nb)%snodl(ix) !--- snodl (snowd on ice) + sfc_var2(i,j,37) = Sfcprop(nb)%tsfc(ix) !--- tsfc composite + sfc_var2(i,j,38) = Sfcprop(nb)%zorl(ix) !--- zorl composite + sfc_var2(i,j,39) = Sfcprop(nb)%weasdl(ix) !--- weasdl (weasd on ice) if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) endif From b0f8c873497a0f75c2293fcdf083ce469ff8423a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Jun 2021 13:30:26 +0000 Subject: [PATCH 156/217] removing a blank in .gitmodules --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 05a2c7c6b..3276090b4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework diff --git a/ccpp/physics b/ccpp/physics index c094f4a8c..e4528fbf3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c094f4a8c527bccc6e5dca84635dc7f8e942193d +Subproject commit e4528fbf39f49ed43faffc42b597622fb78bf724 From cc030eca46f7c671987fb6a4da597441283bdff1 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Jun 2021 13:36:19 +0000 Subject: [PATCH 157/217] removing GFS_typedefs.meta_Jun07 --- ccpp/data/GFS_typedefs.meta_Jun07 | 11031 ---------------------------- 1 file changed, 11031 deletions(-) delete mode 100644 ccpp/data/GFS_typedefs.meta_Jun07 diff --git a/ccpp/data/GFS_typedefs.meta_Jun07 b/ccpp/data/GFS_typedefs.meta_Jun07 deleted file mode 100644 index 6602aad35..000000000 --- a/ccpp/data/GFS_typedefs.meta_Jun07 +++ /dev/null @@ -1,11031 +0,0 @@ -[ccpp-table-properties] - name = GFS_statein_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_statein_type - type = ddt -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys -[prsi] - standard_name = air_pressure_at_interface - long_name = air pressure at model layer interfaces - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys -[prsi(:,1)] - standard_name = air_pressure_at_lowest_model_interface - long_name = air pressure at lowest model interface - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[prsik] - standard_name = dimensionless_exner_function_at_model_interfaces - long_name = dimensionless Exner function at model layer interfaces - units = none - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys -[prsik(:,1)] - standard_name = dimensionless_exner_function_at_lowest_model_interface - long_name = dimensionless Exner function at lowest model interface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[phil] - standard_name = geopotential - long_name = geopotential at model layer centers - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[prsl(:,1)] - standard_name = air_pressure_at_lowest_model_layer - long_name = mean pressure at lowest model layer - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[prslk] - standard_name = dimensionless_exner_function_at_model_layers - long_name = dimensionless Exner function at model layer centers - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[prslk(:,1)] - standard_name = dimensionless_exner_function_at_lowest_model_layer - long_name = dimensionless Exner function at lowest model layer - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[pgr] - standard_name = surface_air_pressure - long_name = surface pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[ugrs(:,1)] - standard_name = x_wind_at_lowest_model_layer - long_name = zonal wind at lowest model layer - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[vgrs(:,1)] - standard_name = y_wind_at_lowest_model_layer - long_name = meridional wind at lowest model layer - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vvl] - standard_name = omega - long_name = layer mean vertical velocity - units = Pa s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[tgrs(:,1)] - standard_name = air_temperature_at_lowest_model_layer - long_name = mean temperature at lowest model layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys -[qgrs(:,:,index_for_water_vapor)] - standard_name = water_vapor_specific_humidity - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,1,index_for_water_vapor)] - standard_name = water_vapor_specific_humidity_at_lowest_model_layer - long_name = water vapor specific humidity at lowest model layer - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qgrs(:,:,index_for_liquid_cloud_condensate)] - standard_name = cloud_condensed_water_mixing_ratio - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,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 = 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_loop_extent) - type = real - kind = kind_phys -[qgrs(:,:,index_for_ice_cloud_condensate)] - standard_name = ice_water_mixing_ratio - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_rain_water)] - standard_name = rain_water_mixing_ratio - long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_snow_water)] - standard_name = snow_water_mixing_ratio - long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_graupel)] - standard_name = graupel_mixing_ratio - long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_ozone)] - standard_name = ozone_mixing_ratio - long_name = ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_water_friendly_aerosols)] - standard_name = water_friendly_aerosol_number_concentration - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - active = (index_for_water_friendly_aerosols > 0) - type = real - kind = kind_phys -[qgrs(:,:,index_for_ice_friendly_aerosols)] - standard_name = ice_friendly_aerosol_number_concentration - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - active = (index_for_ice_friendly_aerosols > 0) - type = real - kind = kind_phys -[qgrs(:,:,index_for_liquid_cloud_number_concentration)] - standard_name = cloud_droplet_number_concentration - long_name = number concentration of cloud droplets (liquid) - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_liquid_cloud_number_concentration > 0) -[qgrs(:,:,index_for_ice_cloud_number_concentration)] - standard_name = ice_number_concentration - long_name = number concentration of ice - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_rain_number_concentration)] - standard_name = rain_number_concentration - long_name = number concentration of rain - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_snow_number_concentration)] - standard_name = snow_number_concentration - long_name = number concentration of snow - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_graupel_number_concentration)] - standard_name = graupel_number_concentration - long_name = number concentration of graupel - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qgrs(:,:,index_for_turbulent_kinetic_energy)] - standard_name = turbulent_kinetic_energy - long_name = turbulent kinetic energy - units = J - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[diss_est] - standard_name = dissipation_estimate_of_air_temperature_at_model_layers - long_name = dissipation estimate model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - -######################################################################## -[ccpp-table-properties] - name = GFS_stateout_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_stateout_type - type = ddt -[gu0] - standard_name = x_wind_updated_by_physics - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gu0(:,1)] - standard_name = x_wind_at_lowest_model_layer_updated_by_physics - long_name = zonal wind at lowest model layer updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gv0] - standard_name = y_wind_updated_by_physics - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gv0(:,1)] - standard_name = y_wind_at_lowest_model_layer_updated_by_physics - long_name = meridional wind at lowest model layer updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gt0] - standard_name = air_temperature_updated_by_physics - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gt0(:,1)] - standard_name = air_temperature_at_lowest_model_layer_updated_by_physics - long_name = temperature at lowest model layer updated by physics - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gq0] - standard_name = tracer_concentration_updated_by_physics - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys -[gq0(:,:,index_for_water_vapor)] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,1,index_for_water_vapor)] - standard_name = water_vapor_specific_humidity_at_lowest_model_layer_updated_by_physics - long_name = water vapor specific humidity at lowest model layer updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gq0(:,:,index_for_ozone)] - standard_name = ozone_concentration_updated_by_physics - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_liquid_cloud_condensate)] - standard_name = cloud_condensed_water_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_ice_cloud_condensate)] - standard_name = ice_water_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_rain_water)] - standard_name = rain_water_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_snow_water)] - standard_name = snow_water_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_graupel)] - standard_name = graupel_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_mass_weighted_rime_factor)] - standard_name = mass_weighted_rime_factor_updated_by_physics - long_name = mass weighted rime factor updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_water_friendly_aerosols)] - standard_name = water_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of water-friendly aerosols updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_water_friendly_aerosols > 0) -[gq0(:,:,index_for_ice_friendly_aerosols)] - standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of ice-friendly aerosols updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_ice_friendly_aerosols > 0) -[gq0(:,:,index_for_liquid_cloud_number_concentration)] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = number concentration of cloud droplets updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_liquid_cloud_number_concentration > 0) -[gq0(:,:,index_for_ice_cloud_number_concentration)] - standard_name = ice_number_concentration_updated_by_physics - long_name = number concentration of ice updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_rain_number_concentration)] - standard_name = rain_number_concentration_updated_by_physics - long_name = number concentration of rain updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_snow_number_concentration)] - standard_name = snow_number_concentration_updated_by_physics - long_name = number concentration of snow updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_graupel_number_concentration)] - standard_name = graupel_number_concentration_updated_by_physics - long_name = number concentration of graupel updated by physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gq0(:,:,index_for_cloud_amount)] - standard_name = cloud_fraction_updated_by_physics - long_name = cloud fraction updated by physics - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - -######################################################################## -[ccpp-table-properties] - name = GFS_sfcprop_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_sfcprop_type - type = ddt -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[oceanfrac] - standard_name = sea_area_fraction - long_name = fraction of horizontal grid area occupied by ocean - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[landfrac] - standard_name = land_area_fraction - long_name = fraction of horizontal grid area occupied by land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[lakefrac] - standard_name = lake_area_fraction - long_name = fraction of horizontal grid area occupied by lake - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[lakedepth] - standard_name = lake_depth - long_name = lake depth - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfco] - standard_name = sea_surface_temperature - long_name = sea surface temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfcl] - standard_name = surface_skin_temperature_over_land - long_name = surface skin temperature over land - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tiice] - standard_name = internal_ice_temperature - long_name = sea ice internal temperature - units = K - dimensions = (horizontal_loop_extent,ice_vertical_dimension) - type = real - kind = kind_phys -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zorlw] - standard_name = surface_roughness_length_over_water - long_name = surface roughness length over water - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zorll] - standard_name = surface_roughness_length_over_land - long_name = surface roughness length over land - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zorli] - standard_name = surface_roughness_length_over_ice - long_name = surface roughness length over ice - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zorlwav] - standard_name = surface_roughness_length_from_wave_model - long_name = surface roughness length from wave model - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snodl] - standard_name = surface_snow_thickness_water_equivalent_over_land - long_name = water equivalent snow depth over land - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hprime] - standard_name = statistical_measures_of_subgrid_orography - long_name = orographic metrics - units = various - dimensions = (horizontal_loop_extent,number_of_statistical_measures_of_subgrid_orography) - type = real - kind = kind_phys -[hprime(:,1)] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[z0base] - standard_name = baseline_surface_roughness_length - long_name = baseline surface roughness length for momentum in meter - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semisbase] - standard_name = baseline_surface_longwave_emissivity - long_name = baseline surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sncovr_ice] - standard_name = surface_snow_area_fraction_over_ice - long_name = surface snow area fraction over ice - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[emis_lnd] - standard_name = surface_longwave_emissivity_over_land - long_name = surface lw emissivity in fraction over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[emis_ice] - standard_name = surface_longwave_emissivity_over_ice - long_name = surface lw emissivity in fraction over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[sfalb_lnd] - standard_name = surface_diffused_shortwave_albedo_over_land - long_name = mean surface diffused sw albedo over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - optional = F - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[sfalb_ice] - standard_name = surface_diffused_shortwave_albedo_over_ice - long_name = mean surface diffused sw albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[sfalb_lnd_bck] - standard_name = surface_snow_free_albedo_over_land - long_name = surface snow-free albedo over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[slope] - standard_name = surface_slope_classification_real - long_name = sfc slope type for lsm - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[shdmin] - standard_name = minimum_vegetation_area_fraction - long_name = min fractional coverage of green vegetation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[shdmax] - standard_name = maximum_vegetation_area_fraction - long_name = max fractional coverage of green vegetation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tg3] - standard_name = deep_soil_temperature - long_name = deep soil temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vfrac] - standard_name = vegetation_area_fraction - long_name = areal fractional cover of green vegetation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vtype] - standard_name = vegetation_type_classification_real - long_name = vegetation type for lsm - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stype] - standard_name = soil_type_classification_real - long_name = soil type for lsm - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uustar] - standard_name = surface_friction_velocity - long_name = boundary layer parameter - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[oro] - standard_name = orography - long_name = orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[oro_uf] - standard_name = orography_unfiltered - long_name = unfiltered orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[conv_act] - standard_name = gf_memory_counter - long_name = Memory counter for GF - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme) -[hice] - standard_name = sea_ice_thickness - long_name = sea ice thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[weasd] - standard_name = water_equivalent_accumulated_snow_depth - long_name = water equiv of acc snow depth over land and sea ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[canopy] - standard_name = canopy_water_amount - long_name = canopy water amount - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffmm] - standard_name = Monin_Obukhov_similarity_function_for_momentum - long_name = Monin-Obukhov similarity function for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffhh] - standard_name = Monin_Obukhov_similarity_function_for_heat - long_name = Monin-Obukhov similarity function for heat - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[f10m] - standard_name = ratio_of_wind_at_lowest_model_layer_and_wind_at_10m - long_name = ratio of sigma level 1 wind and 10m wind - units = ratio - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total precipitation amount in each time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[srflag] - standard_name = flag_for_precipitation_type - long_name = snow/rain flag for precipitation - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[slc] - standard_name = volume_fraction_of_unfrozen_soil_moisture - long_name = liquid soil moisture - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys -[smc] - standard_name = volume_fraction_of_soil_moisture - long_name = total soil moisture - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys -[t2m] - standard_name = temperature_at_2m - long_name = 2 meter temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[th2m] - standard_name = potential_temperature_at_2m - long_name = 2 meter potential temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[q2m] - standard_name = specific_humidity_at_2m - long_name = 2 meter specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tref] - standard_name = sea_surface_reference_temperature - long_name = sea surface reference temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[z_c] - standard_name = sub_layer_cooling_thickness - long_name = sub-layer cooling thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[c_0] - standard_name = coefficient_c_0 - long_name = coefficient 1 to calculate d(Tz)/d(Ts) - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[c_d] - standard_name = coefficient_c_d - long_name = coefficient 2 to calculate d(Tz)/d(Ts) - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[w_0] - standard_name = coefficient_w_0 - long_name = coefficient 3 to calculate d(Tz)/d(Ts) - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[w_d] - standard_name = coefficient_w_d - long_name = coefficient 4 to calculate d(Tz)/d(Ts) - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xt] - standard_name = diurnal_thermocline_layer_heat_content - long_name = heat content in diurnal thermocline layer - units = K m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xs] - standard_name = sea_water_salinity - long_name = salinity content in diurnal thermocline layer - units = ppt m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xu] - standard_name = diurnal_thermocline_layer_x_current - long_name = u-current content in diurnal thermocline layer - units = m2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xv] - standard_name = diurnal_thermocline_layer_y_current - long_name = v-current content in diurnal thermocline layer - units = m2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xz] - standard_name = diurnal_thermocline_layer_thickness - long_name = diurnal thermocline layer thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[zm] - standard_name = ocean_mixed_layer_thickness - long_name = mixed layer thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xtts] - standard_name = sensitivity_of_dtl_heat_content_to_surface_temperature - long_name = d(xt)/d(ts) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[xzts] - standard_name = sensitivity_of_dtl_thickness_to_surface_temperature - long_name = d(xz)/d(ts) - units = m K-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[d_conv] - standard_name = free_convection_layer_thickness - long_name = thickness of free convection layer (FCL) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[ifd] - standard_name = index_of_dtlm_start - long_name = index to start dtlm run or not - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[dt_cool] - standard_name = sub_layer_cooling_amount - long_name = sub-layer cooling amount - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[qrain] - standard_name = sensible_heat_flux_due_to_rainfall - long_name = sensible heat flux due to rainfall - units = W - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_nsstm_run > 0) -[snowxy] - standard_name = number_of_snow_layers - long_name = number of snow layers - units = count - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[tvxy] - standard_name = vegetation_temperature - long_name = vegetation temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[tgxy] - standard_name = ground_temperature_for_noahmp - long_name = ground temperature for noahmp - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[canicexy] - standard_name = canopy_intercepted_ice_mass - long_name = canopy intercepted ice mass - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[canliqxy] - standard_name = canopy_intercepted_liquid_water - long_name = canopy intercepted liquid water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[eahxy] - standard_name = canopy_air_vapor_pressure - long_name = canopy air vapor pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[tahxy] - standard_name = canopy_air_temperature - long_name = canopy air temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[cmxy] - standard_name = surface_drag_coefficient_for_momentum_for_noahmp - long_name = surface drag coefficient for momentum for noahmp - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[chxy] - standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp - long_name = surface exchange coeff heat & moisture for noahmp - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[fwetxy] - standard_name = area_fraction_of_wet_canopy - long_name = area fraction of canopy that is wetted/snowed - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[sneqvoxy] - standard_name = snow_mass_at_previous_time_step - long_name = snow mass at previous time step - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[alboldxy] - standard_name = snow_albedo_at_previous_time_step - long_name = snow albedo at previous time step - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[qsnowxy] - standard_name = snow_precipitation_rate_at_surface - long_name = snow precipitation rate at surface - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[wslakexy] - standard_name = lake_water_storage - long_name = lake water storage - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[zwtxy] - standard_name = water_table_depth - long_name = water table depth - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[waxy] - standard_name = water_storage_in_aquifer - long_name = water storage in aquifer - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[wtxy] - standard_name = water_storage_in_aquifer_and_saturated_soil - long_name = water storage in aquifer and saturated soil - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[tsnoxy] - standard_name = snow_temperature - long_name = snow_temperature - units = K - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[zsnsoxy] - standard_name = layer_bottom_depth_from_snow_surface - long_name = depth from the top of the snow surface at the bottom of the layer - units = m - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[snicexy] - standard_name = snow_layer_ice - long_name = snow layer ice - units = mm - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[snliqxy] - standard_name = snow_layer_liquid_water - long_name = snow layer liquid water - units = mm - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[lfmassxy] - standard_name = leaf_mass - long_name = leaf mass - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[rtmassxy] - standard_name = fine_root_mass - long_name = fine root mass - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[stmassxy] - standard_name = stem_mass - long_name = stem mass - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[woodxy] - standard_name = wood_mass - long_name = wood mass including woody roots - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[stblcpxy] - standard_name = slow_soil_pool_mass_content_of_carbon - long_name = stable carbon in deep soil - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[fastcpxy] - standard_name = fast_soil_pool_mass_content_of_carbon - long_name = short-lived carbon in shallow soil - units = g m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[xlaixy] - standard_name = leaf_area_index - long_name = leaf area index - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .and. flag_for_reading_leaf_area_index_from_input)) -[xsaixy] - standard_name = stem_area_index - long_name = stem area index - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[taussxy] - standard_name = nondimensional_snow_age - long_name = non-dimensional snow age - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[smoiseq] - standard_name = equilibrium_soil_water_content - long_name = equilibrium soil water content - units = m3 m-3 - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[smcwtdxy] - standard_name = soil_water_content_between_soil_bottom_and_water_table - long_name = soil water content between the bottom of the soil and the water table - units = m3 m-3 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[deeprechxy] - standard_name = water_table_recharge_when_deep - long_name = recharge to or from the water table when deep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[rechxy] - standard_name = water_table_recharge_when_shallow - long_name = recharge to or from the water table when shallow - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[snotime] - standard_name = time_since_last_snowfall - long_name = elapsed time since last snowfall - units = s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[albdvis_lnd] - standard_name = surface_albedo_direct_visible_over_land - long_name = direct surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdnir_lnd] - standard_name = surface_albedo_direct_NIR_over_land - long_name = direct surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albivis_lnd] - standard_name = surface_albedo_diffuse_visible_over_land - long_name = diffuse surface albedo visible band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albinir_lnd] - standard_name = surface_albedo_diffuse_NIR_over_land - long_name = diffuse surface albedo NIR band over land - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdvis_ice] - standard_name = surface_albedo_direct_visible_over_ice - long_name = direct surface albedo visible band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdnir_ice] - standard_name = surface_albedo_direct_NIR_over_ice - long_name = direct surface albedo NIR band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albivis_ice] - standard_name = surface_albedo_diffuse_visible_over_ice - long_name = diffuse surface albedo visible band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albinir_ice] - standard_name = surface_albedo_diffuse_NIR_over_ice - long_name = diffuse surface albedo NIR band over ice - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = ( flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[wetness] - standard_name = normalized_soil_wetness_for_land_surface_model - long_name = normalized soil wetness for lsm - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[sh2o] - standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model - long_name = volume fraction of unfrozen soil moisture for lsm - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[keepsmfr] - standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model - long_name = volume fraction of frozen soil moisture for lsm - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[smois] - standard_name = volume_fraction_of_soil_moisture_for_land_surface_model - long_name = volumetric fraction of soil moisture for lsm - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[tslb] - standard_name = soil_temperature_for_land_surface_model - long_name = soil temperature for land surface model - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[clw_surf_land] - standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_land - long_name = moist cloud water mixing ratio at surface over land - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[clw_surf_ice] - standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_ice - long_name = moist cloud water mixing ratio at surface over ice - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[qwv_surf_land] - standard_name = water_vapor_mixing_ratio_at_surface_over_land - long_name = water vapor mixing ratio at surface over land - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[qwv_surf_ice] - standard_name = water_vapor_mixing_ratio_at_surface_over_ice - long_name = water vapor mixing ratio at surface over ice - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[flag_frsoil] - standard_name = flag_for_frozen_soil_physics - long_name = flag for frozen soil physics (RUC) - units = flag - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[rhofr] - standard_name = density_of_frozen_precipitation - long_name = density of frozen precipitation - units = kg m-3 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[tsnow_land] - standard_name = snow_temperature_bottom_first_layer_over_land - long_name = snow temperature at the bottom of the first snow layer over land - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[tsnow_ice] - standard_name = snow_temperature_bottom_first_layer_over_ice - long_name = snow temperature at the bottom of the first snow layer over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[snowfallac_land] - standard_name = total_accumulated_snowfall_over_land - long_name = run-total snow accumulation on the ground - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[snowfallac_ice] - standard_name = total_accumulated_snowfall_over_ice - long_name = run-total snow accumulation on the ice - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[ustm] - standard_name = surface_friction_velocity_drag - long_name = friction velocity isolated for momentum only - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[zol] - standard_name = surface_stability_parameter - long_name = monin obukhov surface stability parameter - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[mol] - standard_name = theta_star - long_name = temperature flux divided by ustar (temperature scale) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[rmol] - standard_name = reciprocal_of_obukhov_length - long_name = one over obukhov length - units = m-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[flhc] - standard_name = surface_exchange_coefficient_for_heat - long_name = surface exchange coefficient for heat - units = W m-2 K-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[flqc] - standard_name = surface_exchange_coefficient_for_moisture - long_name = surface exchange coefficient for moisture - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[chs2] - standard_name = surface_exchange_coefficient_for_heat_at_2m - long_name = exchange coefficient for heat at 2 meters - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[cqs2] - standard_name = surface_exchange_coefficient_for_moisture_at_2m - long_name = exchange coefficient for moisture at 2 meters - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[lh] - standard_name = surface_latent_heat - long_name = latent heating at the surface (pos = up) - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnsfclay) -[evap] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss] - standard_name = surface_specific_humidity - long_name = surface air saturation specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[raincprv] - standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep - long_name = convective_precipitation_amount from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[rainncprv] - standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep - long_name = explicit rainfall from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[iceprv] - standard_name = lwe_thickness_of_ice_amount_from_previous_timestep - long_name = ice amount from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[snowprv] - standard_name = lwe_thickness_of_snow_amount_from_previous_timestep - long_name = snow amount from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[graupelprv] - standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep - long_name = graupel amount from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[draincprv] - standard_name = convective_precipitation_rate_from_previous_timestep - long_name = convective precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[drainncprv] - standard_name = explicit_rainfall_rate_from_previous_timestep - long_name = explicit rainfall rate previous timestep - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[diceprv] - standard_name = ice_precipitation_rate_from_previous_timestep - long_name = ice precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[dsnowprv] - standard_name = snow_precipitation_rate_from_previous_timestep - long_name = snow precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[dgraupelprv] - standard_name = graupel_precipitation_rate_from_previous_timestep - long_name = graupel precipitation rate from previous timestep - units = mm s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[alvsf] - standard_name = mean_vis_albedo_with_strong_cosz_dependency - long_name = mean vis albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[alnsf] - standard_name = mean_nir_albedo_with_strong_cosz_dependency - long_name = mean nir albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[facsf] - standard_name =fractional_coverage_with_strong_cosz_dependency - long_name = fractional coverage with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[facwf] - standard_name = fractional_coverage_with_weak_cosz_dependency - long_name = fractional coverage with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - -######################################################################## -[ccpp-table-properties] - name = GFS_coupling_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_coupling_type - type = ddt -[nirbmdi] - standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step - long_name = sfc nir beam sw downward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[nirdfdi] - standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step - long_name = sfc nir diff sw downward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[visbmdi] - standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step - long_name = sfc uv+vis beam sw downward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[visdfdi] - standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step - long_name = sfc uv+vis diff sw downward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[nirbmui] - standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step - long_name = sfc nir beam sw upward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[nirdfui] - standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step - long_name = sfc nir diff sw upward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[visbmui] - standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step - long_name = sfc uv+vis beam sw upward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[visdfui] - standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step - long_name = sfc uv+vis diff sw upward flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcdsw] - standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step - long_name = total sky sfc downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcnsw] - standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step - long_name = total sky sfc netsw flx into ground - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcdlw] - standard_name = surface_downwelling_longwave_flux_on_radiation_time_step - long_name = total sky sfc downward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfculw] - standard_name = surface_upwelling_longwave_flux_on_radiation_time_step - long_name = total sky sfc upward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[htrlw] - standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_time_step - long_name = total sky longwave heating rate on physics time step - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwUP_allsky] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwDOWN_allsky] - standard_name = RRTMGP_lw_flux_profile_downward_allsky - long_name = RRTMGP downward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[rain_cpl] - standard_name = lwe_thickness_of_precipitation_amount_for_coupling - long_name = total rain precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata) -[rainc_cpl] - standard_name = lwe_thickness_of_convective_precipitation_amount_for_coupling - long_name = total convective precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snow_cpl] - standard_name = lwe_thickness_of_snow_amount_for_coupling - long_name = total snow precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata) -[dusfc_cpl] - standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc x momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvsfc_cpl] - standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc y momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dtsfc_cpl] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dqsfc_cpl] - standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dlwsfc_cpl] - standard_name = cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc downward lw flux mulitplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dswsfc_cpl] - standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dnirbm_cpl] - standard_name = cumulative_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc nir beam downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dnirdf_cpl] - standard_name = cumulative_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc nir diff downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvisbm_cpl] - standard_name = cumulative_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvisdf_cpl] - standard_name = cumulative_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nlwsfc_cpl] - standard_name = cumulative_surface_net_downward_longwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net downward lw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nswsfc_cpl] - standard_name = cumulative_surface_net_downward_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nnirbm_cpl] - standard_name = cumulative_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net nir beam downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nnirdf_cpl] - standard_name = cumulative_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net nir diff downward sw flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nvisbm_cpl] - standard_name = cumulative_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nvisdf_cpl] - standard_name = cumulative_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep - long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dusfci_cpl] - standard_name = instantaneous_surface_x_momentum_flux_for_coupling - long_name = instantaneous sfc x momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvsfci_cpl] - standard_name = instantaneous_surface_y_momentum_flux_for_coupling - long_name = instantaneous sfc y momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dtsfci_cpl] - standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling - long_name = instantaneous sfc sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dqsfci_cpl] - standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling - long_name = instantaneous sfc latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dlwsfci_cpl] - standard_name = instantaneous_surface_downwelling_longwave_flux_for_coupling - long_name = instantaneous sfc downward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dswsfci_cpl] - standard_name = instantaneous_surface_downwelling_shortwave_flux_for_coupling - long_name = instantaneous sfc downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dnirbmi_cpl] - standard_name = instantaneous_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling - long_name = instantaneous sfc nir beam downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dnirdfi_cpl] - standard_name = instantaneous_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling - long_name = instantaneous sfc nir diff downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvisbmi_cpl] - standard_name = instantaneous_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling - long_name = instantaneous sfc uv+vis beam downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvisdfi_cpl] - standard_name = instantaneous_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling - long_name = instantaneous sfc uv+vis diff downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nlwsfci_cpl] - standard_name = instantaneous_surface_net_downward_longwave_flux_for_coupling - long_name = instantaneous net sfc downward lw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nswsfci_cpl] - standard_name = instantaneous_surface_net_downward_shortwave_flux_for_coupling - long_name = instantaneous net sfc downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nnirbmi_cpl] - standard_name = instantaneous_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling - long_name = instantaneous net nir beam sfc downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nnirdfi_cpl] - standard_name = instantaneous_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling - long_name = instantaneous net nir diff sfc downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nvisbmi_cpl] - standard_name = instantaneous_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling - long_name = instantaneous net uv+vis beam downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[nvisdfi_cpl] - standard_name = instantaneous_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling - long_name = instantaneous net uv+vis diff downward sw flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[t2mi_cpl] - standard_name = instantaneous_temperature_at_2m_for_coupling - long_name = instantaneous T2m - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[q2mi_cpl] - standard_name = instantaneous_specific_humidity_at_2m_for_coupling - long_name = instantaneous Q2m - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[u10mi_cpl] - standard_name = instantaneous_x_wind_at_10m_for_coupling - long_name = instantaneous U10m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_wave_coupling) -[v10mi_cpl] - standard_name = instantaneous_y_wind_at_10m_for_coupling - long_name = instantaneous V10m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_wave_coupling) -[tsfci_cpl] - standard_name = instantaneous_surface_skin_temperature_for_coupling - long_name = instantaneous sfc temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[psurfi_cpl] - standard_name = instantaneous_surface_air_pressure_for_coupling - long_name = instantaneous sfc pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[ulwsfcin_cpl] - standard_name = surface_upwelling_longwave_flux_for_coupling - long_name = surface upwelling LW flux for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dusfcin_cpl] - standard_name = surface_x_momentum_flux_for_coupling - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dvsfcin_cpl] - standard_name = surface_y_momentum_flux_for_coupling - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dtsfcin_cpl] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = sfc sensible heat flux input - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[dqsfcin_cpl] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = sfc latent heat flux input for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[hsnoin_cpl] - standard_name = surface_snow_thickness_for_coupling - long_name = sfc snow depth in meters over sea ice for coupling - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[slimskin_cpl] - standard_name = sea_land_ice_mask_in - long_name = sea/land/ice mask input (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[ca_deep] - standard_name = fraction_of_cellular_automata_for_deep_convection - long_name = fraction of cellular automata for deep convection - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_cellular_automata) -[vfact_ca] - standard_name = vertical_weight_for_ca - long_name = vertical weight for ca - units = frac - dimensions = (vertical_dimension) - type = real - kind = kind_phys -[ca1] - standard_name = cellular_automata_global_pattern - long_name = cellular automata global pattern - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_cellular_automata) -[condition] - standard_name = physics_field_for_coupling - long_name = physics_field_for_coupling - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[shum_wts] - standard_name = weights_for_stochastic_shum_perturbation - long_name = weights for stochastic shum perturbation - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_stochastic_shum_option) -[sppt_wts] - standard_name = weights_for_stochastic_sppt_perturbation - long_name = weights for stochastic sppt perturbation - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_stochastic_physics_perturbations .or. flag_for_global_cellular_automata) -[skebu_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind - long_name = weights for stochastic skeb perturbation of x wind - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_stochastic_skeb_option) -[skebv_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind - long_name = weights for stochastic skeb perturbation of y wind - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_stochastic_skeb_option) -[sfc_wts] - standard_name = weights_for_stochastic_surface_physics_perturbation - long_name = weights for stochastic surface physics perturbation - units = none - dimensions = (horizontal_loop_extent,number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys - active = (index_for_stochastic_land_surface_perturbation_type .ne. 0) -[dqdti] - standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection - long_name = instantaneous moisture tendency due to convection - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_chemistry_coupling) -[nwfa2d] - standard_name = tendency_of_water_friendly_aerosols_at_surface - long_name = instantaneous water-friendly sfc aerosol source - units = kg-1 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) -[nifa2d] - standard_name = tendency_of_ice_friendly_aerosols_at_surface - long_name = instantaneous ice-friendly sfc aerosol source - units = kg-1 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) -[ushfsfci] - standard_name = instantaneous_surface_upward_sensible_heat_flux_for_chemistry_coupling - long_name = instantaneous upward sensible heat flux for chemistry coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_chemistry_coupling) -[dkt] - standard_name = instantaneous_atmosphere_heat_diffusivity - long_name = instantaneous atmospheric heat diffusivity - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_chemistry_coupling) -[qci_conv] - standard_name = convective_cloud_condesate_after_rainout - long_name = convective cloud condesate after rainout - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme) -######################################################################## -[ccpp-table-properties] - name = GFS_control_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_control_type - type = ddt -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer -[master] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer -[communicator] - standard_name = mpi_comm - long_name = MPI communicator - units = index - dimensions = () - type = integer -[ntasks] - standard_name = mpi_size - long_name = number of MPI tasks in communicator - units = count - dimensions = () - type = integer -[nthreads] - standard_name = omp_threads - long_name = number of OpenMP threads available for physics schemes - units = count - dimensions = () - type = integer -[nlunit] - standard_name = iounit_namelist - long_name = fortran unit number for file opens - units = none - dimensions = () - type = integer -[fhzero] - standard_name = hours_between_clearing_of_diagnostic_buckets - long_name = hours between clearing of diagnostic buckets - units = h - dimensions = () - type = real - kind = kind_phys -[fn_nml] - standard_name = namelist_filename - long_name = namelist filename - units = none - dimensions = () - type = character - kind = len=64 -[input_nml_file_length] - standard_name = number_of_lines_of_namelist_filename_for_internal_file_reads - long_name = lines in namelist file for internal file reads - units = count - dimensions = () - type = integer -[input_nml_file] - standard_name = namelist_filename_for_internal_file_reads - long_name = namelist filename for internal file reads - units = none - dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) - type = character - kind = len=256 -[logunit] - standard_name = iounit_log - long_name = fortran unit number for logfile - units = none - dimensions = () - type = integer -[fhzero] - standard_name = frequency_for_diagnostic_clearing - long_name = frequency for clearing diagnostic fields - units = h - dimensions = () - type = real - kind = kind_phys -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical -[flag_for_gwd_generic_tend] - standard_name = flag_for_generic_gravity_wave_drag_tendency - long_name = true if GFS_GWD_generic should calculate tendencies - units = flag - dimensions = () - type = logical -[flag_for_pbl_generic_tend] - standard_name = flag_for_generic_planetary_boundary_layer_tendency - long_name = true if GFS_PBL_generic should calculate tendencies - units = flag - dimensions = () - type = logical -[flag_for_dcnv_generic_tend] - standard_name = flag_for_generic_deep_convection_tendency - long_name = true if GFS_DCNV_generic should calculate tendencies - units = flag - dimensions = () - type = logical -[flag_for_scnv_generic_tend] - standard_name = flag_for_generic_shallow_convection_tendency - long_name = true if GFS_SCNV_generic should calculate tendencies - units = flag - dimensions = () - type = logical -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical -[isc] - standard_name = starting_x_index_for_this_MPI_rank - long_name = starting index in the x direction for this MPI rank - units = count - dimensions = () - type = integer -[jsc] - standard_name = starting_y_index_for_this_MPI_rank - long_name = starting index in the y direction for this MPI rank - units = count - dimensions = () - type = integer -[nx] - standard_name = number_of_points_in_x_direction_for_this_MPI_rank - long_name = number of points in x direction for this MPI rank - units = count - dimensions = () - type = integer -[ny] - standard_name = number_of_points_in_y_direction_for_this_MPI_rank - long_name = number of points in y direction for this MPI rank - units = count - dimensions = () - type = integer -[cnx] - standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face - long_name = number of points in x direction for this cubed sphere face - units = count - dimensions = () - type = integer -[cny] - standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face - long_name = number of points in y direction for this cubed sphere face - units = count - dimensions = () - type = integer -[naux2d] - standard_name = number_of_2d_auxiliary_arrays - long_name = number of 2d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer -[naux3d] - standard_name = number_of_3d_auxiliary_arrays - long_name = number of 3d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer -[levs] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer -[ak] - standard_name = a_parameter_of_the_hybrid_coordinate - long_name = a parameter for sigma pressure level calculations - units = Pa - dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) - type = real -[bk] - standard_name = b_parameter_of_the_hybrid_coordinate - long_name = b parameter for sigma pressure level calculations - units = none - dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) - type = real -[levsp1] - standard_name = vertical_dimension_plus_one - long_name = number of vertical levels plus one - units = count - dimensions = () - type = integer -[levsm1] - standard_name = vertical_dimension_minus_one - long_name = number of vertical levels minus one - units = count - dimensions = () - type = integer -[lonr] - standard_name = number_of_equatorial_longitude_points - long_name = number of global points in x-dir (i) along the equator - units = count - dimensions = () - type = integer -[latr] - standard_name = number_of_latitude_points - long_name = number of global points in y-dir (j) along the meridian - units = count - dimensions = () - type = integer -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_block_count) - type = integer -[blksz(ccpp_block_number)] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer -[ncols] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer -[tile_num] - standard_name = number_of_tile - long_name = tile number - units = none - dimensions = () - type = integer -[cplflx] - standard_name = flag_for_flux_coupling - long_name = flag controlling cplflx collection (default off) - units = flag - dimensions = () - type = logical -[cplwav] - standard_name = flag_for_wave_coupling - long_name = flag controlling cplwav collection (default off) - 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) - units = flag - dimensions = () - type = logical -[lsidea] - standard_name = flag_idealized_physics - long_name = flag for idealized physics - units = flag - dimensions = () - type = logical -[fhcyc] - standard_name = frequency_for_surface_cycling_calls - long_name = frequency for surface cycling calls - units = h - dimensions = () - type = real - kind = kind_phys -[nscyc] - standard_name = number_of_timesteps_between_surface_cycling_calls - long_name = number of timesteps between surface cycling calls - units = count - dimensions = () - type = integer -[nszero] - standard_name = number_of_timesteps_between_diagnostic_clearing - long_name = number of timesteps between calls to clear diagnostic variables - units = count - dimensions = () - type = integer -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys -[dtf] - standard_name = time_step_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys -[idat] - standard_name = date_and_time_at_model_initialization - long_name = initialization date and time - units = none - dimensions = (8) - type = integer -[idate] - standard_name = date_and_time_at_model_initialization_reordered - long_name = initial date with different size and ordering - units = none - dimensions = (4) - type = integer -[nsswr] - standard_name = number_of_timesteps_between_shortwave_radiation_calls - long_name = number of timesteps between shortwave radiation calls - units = - dimensions = () - type = integer -[nslwr] - standard_name = number_of_timesteps_between_longwave_radiation_calls - long_name = number of timesteps between longwave radiation calls - units = - dimensions = () - type = integer -[fhswr] - standard_name = frequency_for_shortwave_radiation - long_name = frequency for shortwave radiation - units = s - dimensions = () - type = real - kind = kind_phys -[fhlwr] - standard_name = frequency_for_longwave_radiation - long_name = frequency for longwave radiation - units = s - dimensions = () - type = real - kind = kind_phys -[nhfrad] - standard_name = number_of_timesteps_for_radiation_calls_on_physics_timestep - long_name = number of timesteps for radiation calls on physics timestep (coldstarts only) - units = count - dimensions = () - type = integer -[levr] - standard_name = number_of_vertical_layers_for_radiation_calculations - long_name = number of vertical levels for radiation calculations - units = count - dimensions = () - type = integer -[levrp1] - standard_name = number_of_vertical_layers_for_radiation_calculations_plus_one - long_name = number of vertical levels for radiation calculations + 1 - units = count - dimensions = () - type = integer -[nfxr] - standard_name = number_of_radiation_diagnostic_variables - long_name = number of variables stored in the fluxr array - units = count - dimensions = () - type = integer -[iaerclm] - standard_name = flag_for_aerosol_input_MG_radiation - long_name = flag for using aerosols in Morrison-Gettelman MP_radiation - units = flag - dimensions = () - type = logical -[ntrcaer] - standard_name = number_of_aerosol_tracers_MG - long_name = number of aerosol tracers for Morrison Gettelman MP - units = count - dimensions = () - type = integer -[nrcm] - standard_name = array_dimension_of_random_number - long_name = second dimension of random number stream for RAS - units = count - dimensions = () - type = integer -[iflip] - standard_name = flag_for_vertical_index_direction_control - long_name = iflip - is not the same as flipv - units = flag - dimensions = () - type = integer -[isol] - standard_name = flag_for_solar_constant - long_name = use prescribed solar constant - units = flag - dimensions = () - type = integer -[ico2] - standard_name = flag_for_using_prescribed_global_mean_co2_value - long_name = prescribed global mean value (old opernl) - units = flag - dimensions = () - type = integer -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer -[iems] - standard_name = flag_for_surface_emissivity_control - long_name = surface emissivity control flag, use fixed value of 1 - units = flag - dimensions = () - type = integer -[iaer] - standard_name = flag_for_default_aerosol_effect_in_shortwave_radiation - long_name = default aerosol effect in sw only - units = flag - dimensions = () - type = integer -[icliq_sw] - standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation - long_name = sw optical property for liquid clouds - units = flag - dimensions = () - type = integer -[icice_sw] - standard_name = flag_for_optical_property_for_ice_clouds_for_shortwave_radiation - long_name = sw optical property for ice clouds - units = flag - dimensions = () - type = integer -[icliq_lw] - standard_name = flag_for_optical_property_for_liquid_clouds_for_longwave_radiation - long_name = lw optical property for liquid clouds - units = flag - dimensions = () - type = integer -[icice_lw] - standard_name = flag_for_optical_property_for_ice_clouds_for_longwave_radiation - long_name = lw optical property for ice clouds - units = flag - dimensions = () - type = integer -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method - units = flag - dimensions = () - type = integer -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer -[ictm] - standard_name = flag_for_initial_time_date_control - long_name = flag for initial conditions and forcing - units = flag - dimensions = () - type = integer -[isubc_sw] - standard_name = flag_for_sw_clouds_grid_approximation - long_name = flag for sw clouds sub-grid approximation - units = flag - dimensions = () - type = integer -[isubc_lw] - standard_name = flag_for_lw_clouds_sub_grid_approximation - long_name = flag for lw clouds sub-grid approximation - units = flag - dimensions = () - type = integer -[crick_proof] - standard_name = flag_for_CRICK_proof_cloud_water - long_name = flag for CRICK-Proof cloud water - units = flag - dimensions = () - type = logical -[ccnorm] - standard_name = flag_for_cloud_condensate_normalized_by_cloud_cover - long_name = flag for cloud condensate normalized by cloud cover - units = flag - dimensions = () - type = logical -[norad_precip] - standard_name = flag_for_precipitation_effect_on_radiation - long_name = radiation precip flag for Ferrier/Moorthi - units = flag - dimensions = () - type = logical -[lwhtr] - standard_name = flag_for_output_of_longwave_heating_rate - long_name = flag to output lw heating rate (Radtend%lwhc) - units = flag - dimensions = () - type = logical -[swhtr] - standard_name = flag_for_output_of_shortwave_heating_rate - long_name = flag to output sw heating rate (Radtend%swhc) - units = flag - dimensions = () - type = logical -[active_gases] - standard_name = active_gases_used_by_RRTMGP - long_name = active gases used by RRTMGP - units = none - dimensions = () - type = character - kind = len=128 -[nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP (Model%nGases) - units = count - dimensions = () - type = integer -[rrtmgp_root] - standard_name = directory_for_rte_rrtmgp_source_code - long_name = directory for rte+rrtmgp source code (Model%rrtmgp_root) - units = none - dimensions = () - type = character - kind = len=128 -[lw_file_gas] - standard_name = rrtmgp_kdistribution_lw - long_name = file containing RRTMGP LW k-distribution (Model%lw_file_gas) - units = none - dimensions = () - type = character - kind = len=128 -[lw_file_clouds] - standard_name = rrtmgp_coeff_lw_cloud_optics - long_name = file containing coefficients for RRTMGP LW cloud optics (Model%lw_file_clouds) - units = none - dimensions = () - type = character - kind = len=128 -[rrtmgp_nBandsLW] - standard_name = number_of_lw_bands_rrtmgp - long_name = number of lw bands used in RRTMGP (Model%rrtmgp_nBandsLW) - units = count - dimensions = () - type = integer -[rrtmgp_nGptsLW] - standard_name = number_of_lw_spectral_points_rrtmgp - long_name = number of spectral points in RRTMGP LW calculation (model%rrtmgp_nGptsLW) - units = count - dimensions = () - type = integer -[sw_file_gas] - standard_name = rrtmgp_kdistribution_sw - long_name = file containing RRTMGP SW k-distribution (Model%sw_file_gas) - units = none - dimensions = () - type = character - kind = len=128 -[sw_file_clouds] - standard_name = rrtmgp_coeff_sw_cloud_optics - long_name = file containing coefficients for RRTMGP SW cloud optics (Model%sw_file_clouds) - units = none - dimensions = () - type = character - kind = len=128 -[rrtmgp_nBandsSW] - standard_name = number_of_sw_bands_rrtmgp - long_name = number of sw bands used in RRTMGP (Model%rrtmgp_nBandsSW) - units = count - dimensions = () - type = integer -[rrtmgp_nGptsSW] - standard_name = number_of_sw_spectral_points_rrtmgp - long_name = number of spectral points in RRTMGP SW calculation (model%rrtmgp_nGptsSW) - units = count - dimensions = () - type = integer -[doG_cldoptics] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMG - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical -[use_LW_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical -[doGP_lwscat] - standard_name = flag_to_include_longwave_scattering_in_cloud_optics - long_name = logical flag to control the addition of LW scattering in RRTMGP - units = flag - dimensions = () - type = logical -[rrtmgp_nrghice] - standard_name = number_of_rrtmgp_ice_roughness - long_name = number of ice-roughness categories in RRTMGP calculation (Model%rrtmgp_nrghice) - units = count - dimensions = () - type = integer -[rrtmgp_nGauss_ang] - standard_name = number_of_angles_used_in_gaussian_quadrature - long_name = Number of angles used in Gaussian quadrature - units = count - dimensions = () - type = integer -[do_RRTMGP] - standard_name = flag_for_rrtmgp_radiation_scheme - long_name = flag for RRTMGP scheme - units = flag - dimensions = () - type = logical -[do_GPsw_Glw] - standard_name = scheme_flag - long_name = When true GP is used for SW calculation and G is used for LW calculation - units = flag - dimensions = () - type = logical -[minGPpres] - standard_name = minimum_pressure_in_RRTMGP - long_name = minimum pressure allowed in RRTMGP - units = Pa - dimensions = () - type = real - kind = kind_phys -[minGPtemp] - standard_name = minimum_temperature_in_RRTMGP - long_name = minimum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys -[convert_dry_rho] - standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air - long_name = flag for converting hydrometeors from moist to dry air - units = flag - dimensions = () - type = logical -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_fer_hires] - standard_name = flag_for_fer_hires_microphysics_scheme - long_name = choice of Ferrier-Aligo microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_gfdl] - standard_name = flag_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_thompson] - standard_name = flag_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_wsm6] - standard_name = flag_for_wsm6_microphysics_scheme - long_name = choice of WSM6 microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_zhao_carr] - standard_name = flag_for_zhao_carr_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme - units = flag - dimensions = () - type = integer -[imp_physics_zhao_carr_pdf] - standard_name = flag_for_zhao_carr_pdf_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme with PDF clouds - units = flag - dimensions = () - type = integer -[imp_physics_mg] - standard_name = flag_for_morrison_gettelman_microphysics_scheme - long_name = choice of Morrison-Gettelman microphysics scheme - units = flag - dimensions = () - type = integer -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer -[iovr_max] - standard_name = flag_for_maximum_cloud_overlap_method - long_name = choice of maximum cloud overlap method - units = flag - dimensions = () - type = integer -[iovr_rand] - standard_name = flag_for_random_cloud_overlap_method - long_name = choice of random cloud overlap method - units = flag - dimensions = () - type = integer -[iovr_maxrand] - standard_name = flag_for_maximum_random_cloud_overlap_method - long_name = choice of maximum-random cloud overlap method - units = flag - dimensions = () - type = integer -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real -[psautco] - standard_name = coefficient_from_cloud_ice_to_snow - long_name = auto conversion coeff from ice to snow - units = none - dimensions = (2) - type = real - kind = kind_phys -[prautco] - standard_name = coefficient_from_cloud_water_to_rain - long_name = auto conversion coeff from cloud to rain - units = none - 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 - units = none - dimensions = () - type = real - kind = kind_phys -[wminco] - standard_name = cloud_condensed_water_conversion_threshold - long_name = water and ice minimum threshold for Zhao - units = none - 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 -[seed0] - standard_name = seed_random_numbers_RAS - long_name = random number seed for the RAS scheme - units = none - dimensions = () - type = integer -[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 - units = s - dimensions = () - type = real - kind = kind_phys -[fprcp] - standard_name = number_of_frozen_precipitation_species - long_name = number of frozen precipitation species - units = count - dimensions = () - type = integer -[pdfflag] - standard_name = flag_for_pdf_for_morrison_gettelman_microphysics_scheme - long_name = pdf flag for MG macrophysics - units = flag - dimensions = () - type = integer -[mg_dcs] - standard_name = mg_autoconversion_size_threshold_ice_snow - long_name = autoconversion size threshold for cloud ice to snow for MG microphysics - units = um - dimensions = () - type = real - kind = kind_phys -[mg_qcvar] - standard_name = mg_cloud_water_variance - long_name = cloud water relative variance for MG microphysics - units = - dimensions = () - type = real - kind = kind_phys -[mg_ts_auto_ice] - standard_name = mg_time_scale_for_autoconversion_of_ice - long_name = autoconversion time scale for ice for MG microphysics - units = s - dimensions = (2) - type = real - kind = kind_phys -[mg_rhmini] - standard_name = mg_minimum_rh_for_ice - long_name = relative humidity threshold parameter for nucleating ice for MG microphysics - units = none - dimensions = () - type = real - kind = kind_phys -[mg_ncnst] - standard_name = mg_drop_concentration_constant - long_name = droplet concentration constant for MG microphysics - units = m-3 - dimensions = () - type = real - kind = kind_phys -[mg_ninst] - standard_name = mg_ice_concentration_constant - long_name = ice concentration constant for MG microphysics - units = m-3 - dimensions = () - type = real - kind = kind_phys -[mg_ngnst] - standard_name = mg_graupel_concentration_constant - long_name = graupel concentration constant for MG microphysics - units = m-3 - dimensions = () - type = real - kind = kind_phys -[mg_berg_eff_factor] - standard_name = mg_bergeron_efficiency_factor - long_name = bergeron efficiency factor for MG microphysics - units = frac - dimensions = () - type = real - kind = kind_phys -[mg_alf] - standard_name = mg_tuning_factor_for_alphas - long_name = tuning factor for alphas (alpha = 1 - critical relative humidity) - units = none - dimensions = () - type = real - kind = kind_phys -[mg_qcmin] - standard_name = mg_minimum_cloud_condensed_water_and_ice_mixing_ratio - long_name = minimum cloud condensed water and ice mixing ratio in MG macro clouds - units = kg kg-1 - dimensions = (2) - type = real - kind = kind_phys -[mg_qcmin(1)] - standard_name = mg_minimum_cloud_condensed_water_mixing_ratio - long_name = minimum cloud condensed water mixing ratio in MG macro clouds - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys -[mg_qcmin(2)] - standard_name = mg_minimum_ice_mixing_ratio - long_name = minimum ice mixing ratio in MG macro clouds - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys -[mg_precip_frac_method] - standard_name = mg_type_of_precip_fraction_method - long_name = type of precip fraction method for MG microphysics (in_cloud or max_overlap) - units = none - dimensions = () - type = character - kind = len=16 -[tf] - standard_name = frozen_cloud_threshold_temperature - long_name = threshold temperature below which all cloud is ice - units = K - dimensions = () - type = real - kind = kind_phys -[tcr] - standard_name = cloud_phase_transition_threshold_temperature - long_name = threshold temperature below which cloud starts to freeze - units = K - dimensions = () - type = real - kind = kind_phys -[tcrf] - standard_name = cloud_phase_transition_denominator - long_name = denominator in cloud phase transition = 1/(tcr-tf) - units = K-1 - dimensions = () - type = real - kind = kind_phys -[effr_in] - standard_name = flag_for_cloud_effective_radii - long_name = flag for cloud effective radii calculations in GFDL microphysics - units = flag - dimensions = () - type = logical -[microp_uniform] - standard_name = mg_flag_for_uniform_subcolumns - long_name = flag for uniform subcolumns for MG microphysics - units = flag - dimensions = () - type = logical -[do_cldice] - standard_name = mg_flag_for_cloud_ice_processes - long_name = flag for cloud ice processes for MG microphysics - units = flag - dimensions = () - type = logical -[hetfrz_classnuc] - standard_name = mg_flag_for_heterogeneous_freezing - long_name = flag for heterogeneous freezing for MG microphysics - units = flag - dimensions = () - type = logical -[mg_nccons] - standard_name = mg_flag_drop_concentration_constant - long_name = flag for constant droplet concentration for MG microphysics - units = flag - dimensions = () - type = logical -[mg_nicons] - standard_name = mg_flag_ice_concentration_constant - long_name = flag for constant ice concentration for MG microphysics - units = flag - dimensions = () - type = logical -[mg_ngcons] - standard_name = mg_flag_graupel_concentration_constant - long_name = flag for constant graupel concentration for MG microphysics - units = flag - dimensions = () - type = logical -[sed_supersat] - standard_name = mg_allow_supersat_after_sed - long_name = allow supersaturation after sedimentation for MG microphysics - units = flag - dimensions = () - type = logical -[do_sb_physics] - standard_name = mg_flag_for_sb2001_autoconversion - long_name = flag for SB 2001 autoconversion or accretion for MG microphysics - units = flag - dimensions = () - type = logical -[mg_do_graupel] - standard_name = mg_flag_for_graupel - long_name = flag for graupel for MG microphysics (hail possible if false) - units = flag - dimensions = () - type = logical -[mg_do_hail] - standard_name = mg_flag_for_hail - long_name = flag for hail for MG microphysics (graupel possible if false) - units = flag - dimensions = () - type = logical -[mg_do_ice_gmao] - standard_name = mg_flag_for_gmao_ice_formulation - long_name = flag for gmao ice formulation - units = flag - dimensions = () - type = logical -[mg_do_liq_liu] - standard_name = mg_flag_for_liu_liquid_treatment - long_name = flag for liu liquid treatment - units = flag - dimensions = () - type = logical -[shoc_parm(1)] - standard_name = shoc_tke_dissipatation_pressure_threshold - long_name = pressure below which extra TKE diss. is applied in SHOC - units = Pa - dimensions = () - type = real - kind = kind_phys -[shoc_parm(2)] - standard_name = shoc_tke_dissipation_tunable_parameter - long_name = mult. tuning parameter for TKE diss. in SHOC - units = none - dimensions = () - type = real - kind = kind_phys -[shoc_parm(3)] - standard_name = shoc_tke_dissipation_tunable_parameter_near_surface - long_name = mult. tuning parameter for TKE diss. at surface in SHOC - units = none - dimensions = () - type = real - kind = kind_phys -[shoc_parm(4)] - standard_name = shoc_implicit_TKE_integration_uncentering_term - long_name = uncentering term for TKE integration in SHOC - units = none - dimensions = () - type = real - kind = kind_phys -[shoc_parm(5)] - standard_name = shoc_flag_for_optional_surface_TKE_dissipation - long_name = flag for alt. TKE diss. near surface in SHOC (>0 = ON) - units = none - dimensions = () - type = real - kind = kind_phys -[ncnd] - standard_name = number_of_cloud_condensate_types - long_name = number of cloud condensate types - units = count - dimensions = () - type = integer -[ltaerosol] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol physics - units = flag - dimensions = () - type = logical -[lradar] - standard_name = flag_for_radar_reflectivity - long_name = flag for radar reflectivity - units = flag - dimensions = () - type = logical -[ttendlim] - standard_name = limit_for_temperature_tendency_for_microphysics - long_name = temperature tendency limiter per physics time step - units = K s-1 - dimensions = () - type = real - kind = kind_phys -[lgfdlmprad] - standard_name = flag_for_GFDL_microphysics_radiation_interaction - long_name = flag for GFDL microphysics-radiation interaction - units = flag - dimensions = () - type = logical -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag - dimensions = () - type = integer -[lsm_noah] - standard_name = flag_for_noah_land_surface_scheme - long_name = flag for NOAH land surface model - units = flag - dimensions = () - type = integer -[lsm_noahmp] - standard_name = flag_for_noahmp_land_surface_scheme - long_name = flag for NOAH MP land surface model - units = flag - dimensions = () - type = integer -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag - dimensions = () - type = integer -[lsm_noah_wrfv4] - standard_name = flag_for_noah_wrfv4_land_surface_scheme - long_name = flag for NOAH WRFv4 land surface model - units = flag - dimensions = () - type = integer -[kice] - standard_name = ice_vertical_dimension - long_name = vertical loop extent for ice levels, start at 1 - units = count - dimensions = () - type = integer -[lsoil] - standard_name = soil_vertical_dimension - long_name = number of soil layers - units = count - dimensions = () - type = integer -[lsoil_lsm] - standard_name = soil_vertical_dimension_for_land_surface_model - long_name = number of soil layers internal to land surface model - units = count - dimensions = () - type = integer -[lsnow_lsm] - standard_name = snow_vertical_dimension_for_land_surface_model - long_name = maximum number of snow layers for land surface model - units = count - dimensions = () - type = integer -[lsnow_lsm_lbound] - standard_name = lower_bound_of_snow_vertical_dimension_for_land_surface_model - long_name = lower bound of of snow-related arrays for land surface model - units = count - dimensions = () - type = integer -[lsnow_lsm_ubound] - standard_name = upper_bound_of_snow_vertical_dimension_for_land_surface_model - long_name = upper bound of of snow-related arrays for land surface model - units = count - dimensions = () - type = integer -[zs] - standard_name = depth_of_soil_levels_for_land_surface_model - long_name = depth of soil levels for land surface model - units = m - dimensions = (soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys -[dzs] - standard_name = thickness_of_soil_levels_for_land_surface_model - long_name = thickness of soil levels for land surface model - units = m - dimensions = (soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys -[pores] - standard_name = maximum_soil_moisture_content_for_land_surface_model - long_name = maximum soil moisture for a given soil type for land surface model - units = m - dimensions = (30) - type = real - kind = kind_phys -[resid] - standard_name = minimum_soil_moisture_content_for_land_surface_model - long_name = minimum soil moisture for a given soil type for land surface model - units = m - dimensions = (30) - type = real - kind = kind_phys -[rdlai] - standard_name = flag_for_reading_leaf_area_index_from_input - long_name = flag for reading leaf area index from initial conditions - units = flag - dimensions = () - type = logical -[ua_phys] - standard_name = flag_for_noah_lsm_ua_extension - long_name = flag for using University of Arizona(?) extension for NOAH LSM WRFv4 (see module_sf_noahlsm.F) - units = flag - dimensions = () - type = logical -[usemonalb] - standard_name = flag_for_reading_surface_diffused_shortwave_albedo_from_input - long_name = flag for reading surface diffused shortwave albedo for NOAH LSM WRFv4 (see module_sf_noahlsm.F) - units = flag - dimensions = () - type = logical -[aoasis] - standard_name = potential_evaporation_multiplicative_factor - long_name = potential evaporation multiplicative factor for NOAH LSM WRFv4 (see module_sf_noahlsm.F) - units = none - dimensions = () - type = real - kind = kind_phys -[fasdas] - standard_name = flag_flux_adjusting_surface_data_assimilation_system - long_name = flag to use the flux adjusting surface data assimilation system for NOAH LSM WRFv4 (see module_sf_noahlsm.F) - units = flag - dimensions = () - type = integer -[ivegsrc] - standard_name = vegetation_type_dataset_choice - long_name = land use dataset choice - units = index - dimensions = () - type = integer -[isot] - standard_name = soil_type_dataset_choice - long_name = soil type dataset choice - units = index - dimensions = () - type = integer -[isurban] - standard_name = urban_vegetation_category - long_name = index of the urban vegetation category in the chosen vegetation dataset - units = index - dimensions = () - type = integer -[isice] - standard_name = ice_vegetation_category - long_name = index of the permanent snow/ice category in the chosen vegetation dataset - units = index - dimensions = () - type = integer -[iswater] - standard_name = water_vegetation_category - long_name = index of the water body vegetation category in the chosen vegetation dataset - units = index - dimensions = () - type = integer -[iopt_thcnd] - standard_name = flag_for_thermal_conductivity_option - long_name = choice for thermal conductivity option (see module_sf_noahlsm) - units = index - dimensions = () - type = integer -[spec_adv] - standard_name = flag_for_individual_cloud_species_advected - long_name = flag for individual cloud species advected - units = flag - dimensions = () - type = logical -[flgmin] - standard_name = minimum_large_ice_fraction - long_name = minimum large ice fraction in F-A mp scheme - units = frac - dimensions = (2) - type = real - kind = kind_phys -[iopt_dveg] - standard_name = flag_for_dynamic_vegetation_option - long_name = choice for dynamic vegetation option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_crs] - standard_name = flag_for_canopy_stomatal_resistance_option - long_name = choice for canopy stomatal resistance option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_btr] - standard_name = flag_for_soil_moisture_factor_stomatal_resistance_option - long_name = choice for soil moisture factor for canopy stomatal resistance option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_run] - standard_name = flag_for_runoff_and_groundwater_option - long_name = choice for runoff and groundwater option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_sfc] - standard_name = flag_for_surface_layer_drag_coefficient_option - long_name = choice for surface layer drag coefficient option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_frz] - standard_name = flag_for_supercooled_liquid_water_option - long_name = choice for supercooled liquid water option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_inf] - standard_name = flag_for_frozen_soil_permeability_option - long_name = choice for frozen soil permeability option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_rad] - standard_name = flag_for_radiation_transfer_option - long_name = choice for radiation transfer option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_alb] - standard_name = flag_for_ground_snow_surface_albedo_option - long_name = choice for ground snow surface albedo option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_snf] - standard_name = flag_for_precipitation_partition_option - long_name = choice for precipitation partition option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_tbot] - standard_name = flag_for_lower_boundary_soil_temperature_option - long_name = choice for lower boundary soil temperature option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[iopt_stc] - standard_name = flag_for_soil_and_snow_temperature_time_stepping_option - long_name = choice for soil and snow temperature time stepping option (see noahmp module for definition) - units = index - dimensions = () - type = integer -[use_ufo] - standard_name = flag_for_gcycle_surface_option - long_name = flag for gcycle surface option - units = flag - dimensions = () - type = logical -[lcurr_sf] - standard_name = flag_for_ocean_currents_in_surface_layer_scheme - long_name = flag for taking ocean currents into account in surface layer scheme - units = flag - dimensions = () - type = logical -[pert_cd] - standard_name = flag_for_perturbation_of_surface_drag_coefficient_for_momentum_in_air - long_name = flag for perturbing the surface drag coefficient for momentum in surface layer scheme - units = flag - dimensions = () - type = logical -[ntsflg] - standard_name = flag_for_updating_skin_temperatuer_in_surface_layer_scheme - long_name = flag for updating skin temperature in the surface layer scheme - units = flag - dimensions = () - type = integer -[sfenth] - standard_name = enthalpy_flux_factor - long_name = enthalpy flux factor used in surface layer scheme - units = none - dimensions = () - type = real - kind = kind_phys -[lkm] - standard_name = flag_for_lake_surface_scheme - long_name = flag for lake surface model - units = flag - dimensions = () - type = integer -[ras] - standard_name = flag_for_ras_deep_convection - long_name = flag for ras convection scheme - units = flag - dimensions = () - type = logical -[rhgrd] - standard_name = fa_threshold_relative_humidity_for_onset_of_condensation - long_name = relative humidity threshold parameter for condensation for FA scheme - units = none - dimensions = () - type = real - kind = kind_phys -[flipv] - standard_name = flag_flip - long_name = vertical flip logical - units = flag - dimensions = () - type = logical -[trans_trac] - standard_name = flag_for_convective_transport_of_tracers - long_name = flag for convective transport of tracers - units = flag - dimensions = () - type = logical -[old_monin] - standard_name = flag_for_old_PBL_scheme - long_name = flag for using old PBL schemes - units = flag - dimensions = () - type = logical -[mstrat] - standard_name = flag_for_moorthi_stratus - long_name = flag for moorthi approach for stratus - units = flag - dimensions = () - type = logical -[cscnv] - standard_name = flag_for_Chikira_Sugiyama_deep_convection - long_name = flag for Chikira-Sugiyama convection - units = flag - dimensions = () - type = logical -[satmedmf] - standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL - long_name = flag for scale-aware TKE moist EDMF PBL scheme - units = flag - dimensions = () - type = logical -[shinhong] - standard_name = flag_for_scale_aware_Shinhong_PBL - long_name = flag for scale-aware Shinhong PBL scheme - units = flag - dimensions = () - type = logical -[do_ysu] - standard_name = flag_for_ysu - long_name = flag for YSU PBL scheme - units = flag - dimensions = () - type = logical -[cal_pre] - standard_name = flag_for_precipitation_type_algorithm - long_name = flag controls precip type algorithm - units = flag - dimensions = () - type = logical -[do_aw] - standard_name = flag_for_Arakawa_Wu_adjustment - long_name = flag for Arakawa Wu scale-aware adjustment - units = flag - dimensions = () - type = logical -[do_awdd] - standard_name = flag_arakawa_wu_downdraft - long_name = AW scale-aware option in cs convection downdraft - units = flag - dimensions = () - type = logical -[flx_form] - standard_name = flag_flux_form_CS - long_name = enable use of flux form of equations in CS scheme - units = flag - dimensions = () - type = logical -[do_shoc] - standard_name = flag_for_shoc - long_name = flag for SHOC - units = flag - dimensions = () - type = logical -[shocaftcnv] - standard_name = flag_for_shoc_after_convection - long_name = flag to execute SHOC after convection - units = flag - dimensions = () - type = logical -[oz_phys] - standard_name = flag_for_ozone_physics - long_name = flag for old (2006) ozone physics - units = flag - dimensions = () - type = logical -[oz_phys_2015] - standard_name = flag_for_2015_ozone_physics - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag - dimensions = () - type = logical -[shcnvcw] - standard_name = flag_shallow_convective_cloud - long_name = flag for shallow convective cloud - units = - dimensions = () - type = logical -[redrag] - standard_name = flag_for_reduced_drag_coefficient_over_sea - long_name = flag for reduced drag coeff. over sea - units = flag - dimensions = () - type = logical -[thsfc_loc] - standard_name = flag_for_reference_pressure_theta - long_name = flag for reference pressure in theta calculation - units = flag - dimensions = () - type = logical -[hybedmf] - standard_name = flag_for_hedmf - long_name = flag for hybrid edmf pbl scheme (moninedmf) - units = flag - dimensions = () - type = logical -[dspheat] - standard_name = flag_TKE_dissipation_heating - long_name = flag for tke dissipative heating - units = flag - dimensions = () - type = logical -[hurr_pbl] - standard_name = flag_hurricane_PBL - long_name = flag for hurricane-specific options in PBL scheme - units = flag - dimensions = () - type = logical -[lheatstrg] - standard_name = flag_for_canopy_heat_storage - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical -[random_clds] - standard_name = flag_for_random_clouds_for_RAS - long_name = flag for using random clouds with the RAS scheme - units = flag - dimensions = () - type = logical -[shal_cnv] - standard_name = flag_for_shallow_convection - long_name = flag for calling shallow convection - units = flag - dimensions = () - type = logical -[imfshalcnv] - standard_name = flag_for_mass_flux_shallow_convection_scheme - long_name = flag for mass-flux shallow convection scheme - units = flag - dimensions = () - type = integer -[imfshalcnv_sas] - standard_name = flag_for_sas_shallow_convection_scheme - long_name = flag for SAS shallow convection scheme - units = flag - dimensions = () - type = integer -[imfshalcnv_samf] - standard_name = flag_for_samf_shallow_convection_scheme - long_name = flag for SAMF shallow convection scheme - units = flag - dimensions = () - type = integer -[imfshalcnv_gf] - standard_name = flag_for_gf_shallow_convection_scheme - long_name = flag for Grell-Freitas shallow convection scheme - units = flag - dimensions = () - type = integer -[imfshalcnv_ntiedtke] - standard_name = flag_for_ntiedtke_shallow_convection_scheme - long_name = flag for new Tiedtke shallow convection scheme - units = flag - dimensions = () - type = integer -[imfdeepcnv] - standard_name = flag_for_mass_flux_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer -[imfdeepcnv_sas] - standard_name = flag_for_sas_deep_convection_scheme - long_name = flag for SAS deep convection scheme - units = flag - dimensions = () - type = integer -[imfdeepcnv_samf] - standard_name = flag_for_samf_deep_convection_scheme - long_name = flag for SAMF deep convection scheme - units = flag - dimensions = () - type = integer -[imfdeepcnv_gf] - standard_name = flag_for_gf_deep_convection_scheme - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer -[imfdeepcnv_ntiedtke] - standard_name = flag_for_ntiedtke_deep_convection_scheme - long_name = flag for new Tiedtke deep convection scheme - units = flag - dimensions = () - type = integer -[hwrf_samfdeep] - standard_name = flag_for_hwrf_samfdeepcnv_scheme - long_name = flag for hwrf samfdeepcnv scheme - units = flag - dimensions = () - type = logical -[hwrf_samfshal] - standard_name = flag_for_hwrf_samfshalcnv_scheme - long_name = flag for hwrf samfshalcnv scheme - units = flag - dimensions = () - type = logical -[isatmedmf] - standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL - long_name = choice of scale-aware TKE moist EDMF PBL scheme - units = none - dimensions = () - type = integer -[isatmedmf_vdif] - standard_name = choice_of_original_scale_aware_TKE_moist_EDMF_PBL - long_name = choice of original scale-aware TKE moist EDMF PBL scheme - units = none - dimensions = () - type = integer -[isatmedmf_vdifq] - standard_name = choice_of_updated_scale_aware_TKE_moist_EDMF_PBL - long_name = choice of updated scale-aware TKE moist EDMF PBL scheme - units = none - dimensions = () - type = integer -[nmtvr] - standard_name = number_of_statistical_measures_of_subgrid_orography - long_name = number of topographic variables in GWD - units = count - dimensions = () - type = integer -[jcap] - standard_name = number_of_spectral_wave_trancation_for_sas - long_name = number of spectral wave trancation used only by sascnv and shalcnv - units = count - dimensions = () - type = integer -[cs_parm(1)] - standard_name = updraft_velocity_tunable_parameter_1_CS - long_name = tunable parameter 1 for Chikira-Sugiyama convection - units = m s-1 - dimensions = () - type = real - kind = kind_phys -[cs_parm(2)] - standard_name = updraft_velocity_tunable_parameter_2_CS - long_name = tunable parameter 2 for Chikira-Sugiyama convection - units = m s-1 - dimensions = () - type = real - kind = kind_phys -[cs_parm(3)] - standard_name = detrainment_and_precipitation_tunable_parameter_3_CS - long_name = partition water between detrainment and precipitation (decrease for more precipitation) - units = m - dimensions = () - type = real - kind = kind_phys -[cs_parm(4)] - standard_name = detrainment_and_precipitation_tunable_parameter_4_CS - long_name = partition water between detrainment and precipitation (decrease for more precipitation) - units = m - dimensions = () - type = real - kind = kind_phys -[cs_parm(9)] - standard_name = entrainment_efficiency_tunable_parameter_9_CS - long_name = entrainment efficiency - units = none - dimensions = () - type = real - kind = kind_phys -[cgwf] - standard_name = multiplication_factors_for_convective_gravity_wave_drag - long_name = multiplication factor for convective GWD - units = none - dimensions = (2) - type = real - kind = kind_phys -[cdmbgwd] - 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 -[sup] - standard_name = ice_supersaturation_threshold - long_name = ice supersaturation parameter for PDF clouds - units = none - dimensions = () - type = real - kind = kind_phys -[ctei_rm] - standard_name = critical_cloud_top_entrainment_instability_criteria - long_name = critical cloud top entrainment instability criteria - units = none - dimensions = (2) - type = real - kind = kind_phys -[crtrh(1)] - standard_name = critical_relative_humidity_at_surface - long_name = critical relative humidity at the surface - units = frac - dimensions = () - type = real - kind = kind_phys -[crtrh(2)] - standard_name = critical_relative_humidity_at_PBL_top - long_name = critical relative humidity at the PBL top - units = frac - dimensions = () - type = real - kind = kind_phys -[crtrh(3)] - standard_name = critical_relative_humidity_at_top_of_atmosphere - long_name = critical relative humidity at the top of atmosphere - units = frac - dimensions = () - type = real - kind = kind_phys -[prslrd0] - standard_name = pressure_cutoff_for_rayleigh_damping - long_name = pressure level from which Rayleigh Damping is applied - units = Pa - dimensions = () - type = real - kind = kind_phys -[ral_ts] - standard_name = time_scale_for_rayleigh_damping - long_name = time scale for Rayleigh damping in days - units = d - dimensions = () - type = real - kind = kind_phys -[clam_deep] - standard_name = entrainment_rate_coefficient_deep_convection - long_name = entrainment rate coefficient for deep convection - units = none - dimensions = () - type = real - kind = kind_phys -[c0s_deep] - standard_name = rain_conversion_parameter_deep_convection - long_name = convective rain conversion parameter for deep convection - units = m-1 - dimensions = () - type = real - kind = kind_phys -[c1_deep] - standard_name = detrainment_conversion_parameter_deep_convection - long_name = convective detrainment conversion parameter for deep convection - units = m-1 - dimensions = () - type = real - kind = kind_phys -[betal_deep] - standard_name = downdraft_fraction_reaching_surface_over_land_deep_convection - long_name = downdraft fraction reaching surface over land for deep convection - units = frac - dimensions = () - type = real - kind = kind_phys -[betas_deep] - standard_name = downdraft_fraction_reaching_surface_over_water_deep_convection - long_name = downdraft fraction reaching surface over water for deep convection - units = frac - dimensions = () - type = real - kind = kind_phys -[evfact_deep] - standard_name = rain_evaporation_coefficient_deep_convection - long_name = convective rain evaporation coefficient for deep convection - units = frac - dimensions = () - type = real - kind = kind_phys -[evfactl_deep] - standard_name = rain_evaporation_coefficient_over_land_deep_convection - long_name = convective rain evaporation coefficient over land for deep convection - units = frac - dimensions = () - type = real - kind = kind_phys -[pgcon_deep] - standard_name = momentum_transport_reduction_factor_pgf_deep_convection - long_name = reduction factor in momentum transport due to deep convection induced pressure gradient force - units = frac - dimensions = () - type = real - kind = kind_phys -[asolfac_deep] - standard_name = aerosol_aware_parameter_deep_convection - long_name = aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for deep convection - units = none - dimensions = () - type = real - kind = kind_phys -[clam_shal] - standard_name = entrainment_rate_coefficient_shallow_convection - long_name = entrainment rate coefficient for shallow convection - units = none - dimensions = () - type = real - kind = kind_phys -[c0s_shal] - standard_name = rain_conversion_parameter_shallow_convection - long_name = convective rain conversion parameter for shallow convection - units = m-1 - dimensions = () - type = real - kind = kind_phys -[c1_shal] - standard_name = detrainment_conversion_parameter_shallow_convection - long_name = convective detrainment conversion parameter for shallow convection - units = m-1 - dimensions = () - type = real - kind = kind_phys -[pgcon_shal] - standard_name = momentum_transport_reduction_factor_pgf_shallow_convection - long_name = reduction factor in momentum transport due to shallow convection induced pressure gradient force - units = frac - dimensions = () - type = real - kind = kind_phys -[asolfac_shal] - standard_name = aerosol_aware_parameter_shallow_convection - long_name = aerosol-aware parameter inversely proportional to CCN number concentraion from Lim (2011) for shallow convection - units = none - dimensions = () - type = real - kind = kind_phys -[xkzm_m] - standard_name = atmosphere_momentum_diffusivity_background - long_name = background vertical diffusion for momentum - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys -[xkzm_h] - standard_name = atmosphere_heat_diffusivity_background - long_name = background vertical diffusion for heat q - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys -[xkzm_s] - standard_name = diffusivity_background_sigma_level - long_name = sigma threshold for background mom. diffusion - units = none - dimensions = () - type = real - kind = kind_phys -[nst_anl] - standard_name = flag_for_nsstm_analysis_in_gcycle - long_name = flag for NSSTM analysis in gcycle/sfcsub - units = flag - dimensions = () - type = logical -[nstf_name(1)] - standard_name = flag_for_nsstm_run - long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 - units = flag - dimensions = () - type = integer -[nstf_name(4)] - standard_name = vertical_temperature_average_range_lower_bound - long_name = zsea1 in mm - units = mm - dimensions = () - type = integer -[nstf_name(5)] - standard_name = vertical_temperature_average_range_upper_bound - long_name = zsea2 in mm - units = mm - dimensions = () - type = integer -[frac_grid] - standard_name = flag_for_fractional_grid - long_name = flag for fractional grid - units = flag - dimensions = () - type = logical -[min_lakeice] - standard_name = lake_ice_minimum - long_name = minimum lake ice value - units = frac - dimensions = () - type = real - kind = kind_phys -[min_seaice] - standard_name = sea_ice_minimum - long_name = minimum sea ice value - units = frac - dimensions = () - type = real - kind = kind_phys -[rho_h2o] - standard_name = density_of_fresh_water - long_name = density of fresh water - units = kg m-3 - dimensions = () - type = real - kind = kind_phys -[sfc_z0_type] - standard_name = flag_for_surface_roughness_option_over_water - long_name = surface roughness options over water - units = flag - dimensions = () - type = integer -[xkzminv] - standard_name = atmosphere_heat_diffusivity_background_maximum - long_name = maximum background value of heat diffusivity - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys -[moninq_fac] - standard_name = atmosphere_diffusivity_coefficient_factor - long_name = multiplicative constant for atmospheric diffusivities (AKA alpha) - units = none - dimensions = () - type = real - kind = kind_phys -[dspfac] - standard_name = tke_dissipative_heating_factor - long_name = tke dissipative heating factor - units = none - dimensions = () - type = real - kind = kind_phys -[bl_upfr] - standard_name = updraft_fraction_in_boundary_layer_mass_flux_scheme - long_name = updraft fraction in boundary layer mass flux scheme - units = none - dimensions = () - type = real - kind = kind_phys -[bl_dnfr] - standard_name = downdraft_fraction_in_boundary_layer_mass_flux_scheme - long_name = downdraft fraction in boundary layer mass flux scheme - units = none - dimensions = () - type = real - kind = kind_phys -[z0fac] - standard_name = surface_roughness_fraction_factor - long_name = surface roughness fraction for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys -[e0fac] - standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux - long_name = latent heat flux fraction relative to sensible heat flux for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys -[nca] - standard_name = number_of_independent_cellular_automata - long_name = number of independent cellular automata - units = count - dimensions = () - type = integer -[nlives] - standard_name = cellular_automata_lifetime - long_name = cellular automata lifetime - units = count - dimensions = () - type = integer -[ncells] - standard_name = cellular_automata_finer_grid - long_name = cellular automata finer grid - units = count - dimensions = () - type = integer -[nfracseed] - standard_name = cellular_automata_seed_probability - long_name = cellular automata seed probability - units = fraction - dimensions = () - type = real - kind = kind_phys -[nseed] - standard_name = cellular_automata_seed_frequency - long_name = cellular automata seed frequency in units of time steps - units = count - dimensions = () - type = integer -[do_ca] - standard_name = flag_for_cellular_automata - long_name = cellular automata main switch - units = flag - dimensions = () - type = logical -[ca_sgs] - standard_name = flag_for_sgs_cellular_automata - long_name = switch for sgs ca - units = flag - dimensions = () - type = logical -[ca_global] - standard_name = flag_for_global_cellular_automata - long_name = switch for global ca - units = flag - dimensions = () - type = logical -[ca_closure] - standard_name = flag_for_global_cellular_automata_closure - long_name = switch for ca on closure - units = flag - dimensions = () - type = logical -[ca_entr] - standard_name = flag_for_global_cellular_automata_entr - long_name = switch for ca on entr - units = flag - dimensions = () - type = logical -[ca_trigger] - standard_name = flag_for_global_cellular_automata_trigger - long_name = switch for ca on trigger - units = flag - dimensions = () - type = logical -[ca_smooth] - standard_name = flag_for_gaussian_spatial_filter - long_name = switch for gaussian spatial filter - units = flag - dimensions = () - type = logical -[iseed_ca] - standard_name = seed_for_random_number_generation_in_cellular_automata_scheme - long_name = seed for random number generation in ca scheme - units = none - dimensions = () - type = integer -[nspinup] - standard_name = number_of_iterations_to_spin_up_cellular_automata - long_name = number of iterations to spin up the ca - units = count - dimensions = () - type = integer -[nthresh] - standard_name = threshold_for_perturbed_vertical_velocity - long_name = threshold used for perturbed vertical velocity - units = m s-1 - dimensions = () - type = real - kind = kind_phys -[do_sppt] - standard_name = flag_for_stochastic_physics_perturbations - long_name = flag for stochastic physics perturbations - units = flag - dimensions = () - type = logical -[pert_mp] - standard_name = flag_for_stochastic_microphysics_perturbations - long_name = flag for stochastic microphysics perturbations - units = flag - dimensions = () - type = logical -[pert_clds] - standard_name = flag_for_stochastic_cloud_fraction_perturbations - long_name = flag for stochastic cloud fraction perturbations - units = flag - dimensions = () - type = logical -[sppt_amp] - standard_name = total_ampltiude_of_sppt_perturbation - long_name = toal ampltidue of stochastic sppt perturbation - units = none - dimensions = () - type = real - kind = kind_phys -[pert_radtend] - standard_name = flag_for_stochastic_radiative_heating_perturbations - long_name = flag for stochastic radiative heating perturbations - units = flag - dimensions = () - type = logical -[use_zmtnblck] - standard_name = flag_for_mountain_blocking - long_name = flag for mountain blocking - units = flag - dimensions = () - type = logical -[do_shum] - standard_name = flag_for_stochastic_shum_option - long_name = flag for stochastic shum option - units = flag - dimensions = () - type = logical -[do_skeb] - standard_name = flag_for_stochastic_skeb_option - long_name = flag for stochastic skeb option - units = flag - dimensions = () - type = logical -[lndp_type] - standard_name = index_for_stochastic_land_surface_perturbation_type - long_name = index for stochastic land surface perturbations type - units = index - dimensions = () - type = integer -[n_var_lndp] - standard_name = number_of_land_surface_variables_perturbed - long_name = number of land surface variables perturbed - units = count - dimensions = () - type = integer -[lndp_prt_list] - standard_name =magnitude_of_perturbations_for_landperts - long_name = magnitude of perturbations for landperts - units = variable - dimensions = (number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys -[lndp_var_list] - standard_name = variables_to_be_perturbed_for_landperts - long_name = variables to be perturbed for landperts - units = none - dimensions = (number_of_land_surface_variables_perturbed) - type = character - kind = len=3 -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer -[ntracp1] - standard_name = number_of_tracers_plus_one - long_name = number of tracers plus one - units = count - dimensions = () - type = integer -[ntqv] - standard_name = index_for_water_vapor - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer -[ntoz] - standard_name = index_for_ozone - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer -[ntcw] - standard_name = index_for_liquid_cloud_condensate - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer -[ntiw] - standard_name = index_for_ice_cloud_condensate - long_name = tracer index for ice water - units = index - dimensions = () - type = integer -[ntrw] - standard_name = index_for_rain_water - long_name = tracer index for rain water - units = index - dimensions = () - type = integer -[ntsw] - standard_name = index_for_snow_water - long_name = tracer index for snow water - units = index - dimensions = () - type = integer -[ntgl] - standard_name = index_for_graupel - long_name = tracer index for graupel - units = index - dimensions = () - type = integer -[ntclamt] - standard_name = index_for_cloud_amount - long_name = tracer index for cloud amount integer - units = index - dimensions = () - type = integer -[ntlnc] - standard_name = index_for_liquid_cloud_number_concentration - long_name = tracer index for liquid number concentration - units = index - dimensions = () - type = integer -[ntinc] - standard_name = index_for_ice_cloud_number_concentration - long_name = tracer index for ice number concentration - units = index - dimensions = () - type = integer -[ntrnc] - standard_name = index_for_rain_number_concentration - long_name = tracer index for rain number concentration - units = index - dimensions = () - type = integer -[ntsnc] - standard_name = index_for_snow_number_concentration - long_name = tracer index for snow number concentration - units = index - dimensions = () - type = integer -[ntgnc] - standard_name = index_for_graupel_number_concentration - long_name = tracer index for graupel number concentration - units = index - dimensions = () - type = integer -[ntke] - standard_name = index_for_turbulent_kinetic_energy - long_name = tracer index for turbulent kinetic energy - units = index - dimensions = () - type = integer -[nqrimef] - standard_name = index_for_mass_weighted_rime_factor - long_name = tracer index for mass weighted rime factor - units = index - dimensions = () - type = integer -[ntwa] - standard_name = index_for_water_friendly_aerosols - long_name = tracer index for water friendly aerosol - units = index - dimensions = () - type = integer -[ntia] - standard_name = index_for_ice_friendly_aerosols - long_name = tracer index for ice friendly aerosol - units = index - dimensions = () - type = integer -[ntchm] - standard_name = number_of_chemical_tracers - long_name = number of chemical tracers - units = count - dimensions = () - type = integer -[ntchs] - standard_name = index_for_first_chemical_tracer - long_name = tracer index for first chemical tracer - units = index - dimensions = () - type = integer -[ntdiag] - standard_name = diagnostics_control_for_chemical_tracers - long_name = array to control diagnostics for chemical tracers - units = flag - dimensions = (number_of_chemical_tracers) - type = logical -[fscav] - standard_name = coefficients_for_aerosol_scavenging - long_name = array of aerosol scavenging coefficients - units = none - dimensions = (number_of_chemical_tracers) - type = real - kind = kind_phys -[ntot2d] - standard_name = number_of_fields_in_phyf2d - long_name = total number of variables for phyf2d - units = count - dimensions = () - type = integer -[ntot3d] - standard_name = number_of_fields_in_phyf3d - long_name = total number of variables for phyf3d - units = count - dimensions = () - type = integer -[indcld] - standard_name = index_for_cloud_fraction_in_3d_arrays_for_microphysics - long_name = index of cloud fraction in phyf3d (used only for SHOC or MG) - units = index - dimensions = () - type = integer -[num_p2d] - standard_name = array_dimension_of_2d_arrays_for_microphysics - long_name = number of 2D arrays needed for microphysics - units = count - dimensions = () - type = integer -[num_p3d] - standard_name = array_dimension_of_3d_arrays_for_microphysics - long_name = number of 3D arrays needed for microphysics - units = count - dimensions = () - type = integer -[nkbfshoc] - standard_name = index_of_kinematic_buoyancy_flux_from_shoc_in_phy_f3d - long_name = the index of upward kinematic buoyancy flux from SHOC in phy_f3d - units = index - dimensions = () - type = integer -[nahdshoc] - standard_name = index_of_atmosphere_heat_diffusivity_from_shoc_in_phy_f3d - long_name = the index of diffusivity for heat from from SHOC in phy_f3d - units = index - dimensions = () - type = integer -[nscfshoc] - standard_name = index_of_subgrid_scale_cloud_fraction_from_shoc_in_phy_f3d - long_name = the index of subgrid-scale cloud fraction from from SHOC in phy_f3d - units = index - dimensions = () - type = integer -[ncnvcld3d] - standard_name = number_of_convective_3d_cloud_fields - long_name = number of convective 3d clouds fields - units = count - dimensions = () - type = integer -[npdf3d] - standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds - long_name = number of 3d arrays associated with pdf based clouds/mp - units = count - dimensions = () - type = integer -[nctp] - standard_name = number_of_cloud_types_CS - long_name = number of cloud types in Chikira-Sugiyama scheme - units = count - dimensions = () - type = integer -[ncnvw] - standard_name = index_for_convective_cloud_water_mixing_ratio_in_phy_f3d - long_name = the index of convective cloud water mixing ratio in phy f3d - units = index - dimensions = () - type = integer -[ncnvc] - standard_name = index_for_convective_cloud_cover_in_phy_f3d - long_name = the index of convective cloud cover in phy f3d - units = index - dimensions = () - type = integer -[nleffr] - standard_name = index_for_cloud_liquid_water_effective_radius - long_name = the index of cloud liquid water effective radius in phy_f3d - units = index - dimensions = () - type = integer -[nieffr] - standard_name = index_for_ice_effective_radius - long_name = the index of ice effective radius in phy_f3d - units = index - dimensions = () - type = integer -[nreffr] - standard_name = index_for_rain_effective_radius - long_name = the index of rain effective radius in phy_f3d - units = index - dimensions = () - type = integer -[nseffr] - standard_name = index_for_snow_effective_radius - long_name = the index of snow effective radius in phy_f3d - units = index - dimensions = () - type = integer -[ngeffr] - standard_name = index_for_graupel_effective_radius - long_name = the index of graupel effective radius in phy_f3d - units = index - dimensions = () - type = integer -[nT2delt] - standard_name = index_for_air_temperature_two_timesteps_back - long_name = the index of air temperature two timesteps back in phy f3d - units = - dimensions = () - type = integer -[nTdelt] - standard_name = index_for_air_temperature_at_previous_timestep - long_name = the index of air temperature at previous timestep in phy f3d - units = - dimensions = () - type = integer -[nqv2delt] - standard_name = index_for_specific_humidity_two_timesteps_back - long_name = the index of specific humidity two timesteps back in phy f3d - units = - dimensions = () - type = integer -[nqvdelt] - standard_name = index_for_specific_humidity_at_previous_timestep - long_name = the index of specific humidity at previous timestep in phy f3d - units = - dimensions = () - type = integer -[nps2delt] - standard_name = index_for_surface_air_pressure_two_timesteps_back - long_name = the index of surface air pressure two timesteps back in phy f2d - units = - dimensions = () - type = integer -[npsdelt] - standard_name = index_for_surface_air_pressure_at_previous_timestep - long_name = the index of surface air pressure at previous timestep in phy f2d - units = - dimensions = () - type = integer -[ncnvwind] - standard_name = index_for_surface_wind_enhancement_due_to_convection - long_name = the index of surface wind enhancement due to convection in phy f2d - units = - dimensions = () - type = integer -[debug] - standard_name = flag_debug - long_name = control flag for debug - units = flag - dimensions = () - type = logical -[ipt] - standard_name = index_for_diagnostic_printout - long_name = horizontal index for point used for diagnostic printout - units = index - dimensions = () - type = integer -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical -[lsswr] - standard_name = flag_to_calc_sw - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical -[lslwr] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical -[solhr] - standard_name = forecast_hour_of_the_day - long_name = time in hours after 00z at the current timestep - units = h - dimensions = () - type = real - kind = kind_phys -[solcon] - standard_name = solar_constant - long_name = solar constant (sun-earth distant adjusted) - units = W m-2 - dimensions = () - type = real - kind = kind_phys -[slag] - standard_name = equation_of_time - long_name = equation of time (radian) - units = radian - dimensions = () - type = real - kind = kind_phys -[sdec] - standard_name = sine_of_solar_declination_angle - long_name = sin of the solar declination angle - units = none - dimensions = () - type = real - kind = kind_phys -[cdec] - standard_name = cosine_of_solar_declination_angle - long_name = cos of the solar declination angle - units = none - dimensions = () - type = real - kind = kind_phys -[clstp] - standard_name = convective_cloud_switch - long_name = index used by cnvc90 (for convective clouds) - units = none - dimensions = () - type = real - kind = kind_phys -[phour] - standard_name = forecast_time_at_previous_timestep - long_name = forecast time at the previous timestep - units = h - dimensions = () - type = real - kind = kind_phys -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys -[zhour] - standard_name = time_since_diagnostics_zeroed - long_name = time since diagnostics variables have been zeroed - units = h - dimensions = () - type = real - kind = kind_phys -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer -[first_time_step] - standard_name = flag_for_first_time_step - long_name = flag for first time step for time integration loop (cold/warmstart) - units = flag - dimensions = () - type = logical -[restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical -[hydrostatic] - standard_name = flag_for_hydrostatic_solver - long_name = flag for hydrostatic solver from dynamics - units = flag - dimensions = () - type = logical -[jdat] - standard_name = forecast_date_and_time - long_name = current forecast date and time - units = none - dimensions = (8) - type = integer -[imn] - standard_name = forecast_month - long_name = current forecast month - units = none - dimensions = () - type = integer -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys -[iccn] - standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics - long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = none - dimensions = () - type = integer -[sec] - standard_name = seconds_elapsed_since_model_initialization - long_name = seconds elapsed since model initialization - units = s - dimensions = () - type = real - kind = kind_phys -[si] - standard_name = vertical_sigma_coordinate_for_radiation_initialization - long_name = vertical sigma coordinate for radiation initialization - units = none - dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) - type = real - kind = kind_phys -[dxinv] - standard_name = inverse_scaling_factor_for_critical_relative_humidity - long_name = inverse scaling factor for critical relative humidity - units = rad2 m-2 - dimensions = () - type = real - kind = kind_phys -[dxmax] - standard_name = maximum_scaling_factor_for_critical_relative_humidity - long_name = maximum scaling factor for critical relative humidity - units = m2 rad-2 - dimensions = () - type = real - kind = kind_phys -[dxmin] - standard_name = minimum_scaling_factor_for_critical_relative_humidity - long_name = minimum scaling factor for critical relative humidity - units = m2 rad-2 - dimensions = () - type = real - kind = kind_phys -[rhcmax] - standard_name = maximum_critical_relative_humidity - long_name = maximum critical relative humidity - units = frac - dimensions = () - type = real - kind = kind_phys -[icloud] - standard_name = cloud_effect_to_optical_depth_and_cloud_fraction - long_name = cloud effect to the optical depth and cloud fraction in radiation - units = flag - dimensions = () - type = integer -[gwd_opt] - standard_name = gwd_opt - long_name = flag to choose gwd scheme - units = flag - dimensions = () - type = integer -[do_mynnedmf] - standard_name = do_mynnedmf - long_name = flag to activate MYNN-EDMF - units = flag - dimensions = () - type = logical -[do_mynnsfclay] - standard_name = do_mynnsfclay - long_name = flag to activate MYNN surface layer - units = flag - dimensions = () - type = logical -[do_myjsfc] - standard_name = do_myjsfc - long_name = flag to activate MYJ surface layer scheme - units = flag - dimensions = () - type = logical -[do_myjpbl] - standard_name = do_myjpbl - long_name = flag to activate MYJ PBL scheme - units = flag - dimensions = () - type = logical -[grav_settling] - standard_name = grav_settling - long_name = flag to activate gravitational setting of fog - units = flag - dimensions = () - type = integer -[bl_mynn_tkebudget] - standard_name = tke_budget - long_name = flag for activating TKE budget - units = flag - dimensions = () - type = integer -[bl_mynn_tkeadvect] - standard_name = tke_advect - long_name = flag for activating TKE advection - units = flag - dimensions = () - type = logical -[bl_mynn_cloudpdf] - standard_name = cloudpdf - long_name = flag to determine which cloud PDF to use - units = flag - dimensions = () - type = integer -[bl_mynn_mixlength] - standard_name = mixing_length_flag - long_name = flag to determine which mixing length form to use - units = flag - dimensions = () - type = integer -[bl_mynn_edmf] - standard_name = edmf_flag - long_name = flag to activate the mass-flux scheme - units = flag - dimensions = () - type = integer -[bl_mynn_edmf_mom] - standard_name = edmf_momentum_transport_flag - long_name = flag to activate the transport of momentum - units = flag - dimensions = () - type = integer -[bl_mynn_edmf_tke] - standard_name = edmf_tke_transport_flag - long_name = flag to activate the transport of TKE - units = flag - dimensions = () - type = integer -[bl_mynn_edmf_part] - standard_name = edmf_partition_flag - long_name = flag to partitioning og the MF and ED areas - units = flag - dimensions = () - type = integer -[bl_mynn_cloudmix] - standard_name = cloud_specie_mix_flag - long_name = flag to activate mixing of cloud species - units = flag - dimensions = () - type = integer -[bl_mynn_mixqt] - standard_name = mix_total_water_flag - long_name = flag to mix total water or individual species - units = flag - dimensions = () - type = integer -[bl_mynn_output] - standard_name = mynn_output_flag - long_name = flag initialize and output extra 3D variables - units = flag - dimensions = () - type = integer -[icloud_bl] - standard_name = couple_sgs_clouds_to_radiation_flag - long_name = flag for coupling sgs clouds to radiation - units = flag - dimensions = () - type = integer -[var_ric] - standard_name = flag_variable_bulk_richardson_number - long_name = flag for calculating variable bulk richardson number for hurricane PBL - units = flag - dimensions = () - type = real - kind = kind_phys -[coef_ric_l] - standard_name = coefficient_for_variable_bulk_richardson_number_over_land - long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over land - units = none - dimensions = () - type = real - kind = kind_phys -[coef_ric_s] - standard_name = coefficient_for_variable_bulk_richardson_number_over_water - long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over water - units = none - dimensions = () - type = real - kind = kind_phys -[do_ugwp] - standard_name = do_ugwp - long_name = flag to activate CIRES UGWP - units = flag - dimensions = () - type = logical -[do_tofd] - standard_name = turb_oro_form_drag_flag - long_name = flag for turbulent orographic form drag - units = flag - dimensions = () - type = logical -[do_gwd] - standard_name = flag_for_gravity_wave_drag - long_name = flag for gravity wave drag (gwd) - units = flag - dimensions = () - type = logical -[do_cnvgwd] - standard_name = flag_for_convective_gravity_wave_drag - long_name = flag for convective gravity wave drag (gwd) - units = flag - dimensions = () - type = logical -[ldiag_ugwp] - standard_name = diag_ugwp_flag - long_name = flag for CIRES UGWP Diagnostics - units = flag - dimensions = () - type = logical -[uni_cld] - standard_name = flag_for_uni_cld - long_name = flag for uni_cld - units = flag - dimensions = () - type = logical -[lmfshal] - standard_name = flag_for_lmfshal - long_name = flag for lmfshal - units = flag - dimensions = () - type = logical -[do_ugwp_v0] - standard_name = flag_for_ugwp_version_0 - long_name = flag to activate ver 0 CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v0_orog_only] - standard_name = flag_for_ugwp_version_0_orographic_gwd - long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v0_nst_only] - standard_name = flag_for_ugwp_version_0_nonorographic_gwd - long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_gsl_drag_ls_bl] - standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag - long_name = flag to activate GSL drag suite - large-scale GWD and blocking - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_gsl_drag_ss] - standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag - long_name = flag to activate GSL drag suite - small-scale GWD - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_gsl_drag_tofd] - standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag - long_name = flag to activate GSL drag suite - turb orog form drag - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v1] - standard_name = flag_for_ugwp_version_1 - long_name = flag to activate ver 1 CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v1_orog_only] - standard_name = flag_for_ugwp_version_1_orographic_gwd - long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v1_w_gsldrag] - standard_name = flag_for_ugwp_version_1_nonorographic_gwd - long_name = flag to activate ver 1 CIRES UGWP - with OGWD of GSL - units = flag - dimensions = () - type = logical - intent = in - optional = F -[lmfdeep2] - standard_name = flag_for_scale_aware_mass_flux_convection - long_name = flag for some scale-aware mass-flux convection scheme active - units = flag - dimensions = () - type = logical - -######################################################################## -[ccpp-table-properties] - name = GFS_grid_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_grid_type - type = ddt -[area] - standard_name = cell_area - long_name = area of the grid cell - units = m2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dx] - standard_name = cell_size - long_name = relative dx for the grid cell - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[coslat] - standard_name = cosine_of_latitude - long_name = cosine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sinlat] - standard_name = sine_of_latitude - long_name = sine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlat_d] - standard_name = latitude_in_degree - long_name = latitude in degree north - units = degree_north - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlon_d] - standard_name = longitude_in_degree - long_name = longitude in degree east - units = degree_east - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[jindx1_o3] - standard_name = lower_ozone_interpolation_index - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (index_for_ozone>0) -[jindx2_o3] - standard_name = upper_ozone_interpolation_index - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (index_for_ozone>0) -[ddy_o3] - standard_name = ozone_interpolation_weight - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (index_for_ozone>0) -[jindx1_h] - standard_name = lower_water_vapor_interpolation_index - long_name = interpolation low index for stratospheric water vapor - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_stratospheric_water_vapor_physics) -[jindx2_h] - standard_name = upper_water_vapor_interpolation_index - long_name = interpolation high index for stratospheric water vapor - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_stratospheric_water_vapor_physics) -[ddy_h] - standard_name = water_vapor_interpolation_weight - long_name = interpolation high index for stratospheric water vapor - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_stratospheric_water_vapor_physics) -[jindx1_aer] - standard_name = lower_aerosol_y_interpolation_index - long_name = interpolation low index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_aerosol_input_MG_radiation) -[jindx2_aer] - standard_name = upper_aerosol_y_interpolation_index - long_name = interpolation high index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_aerosol_input_MG_radiation) -[ddy_aer] - standard_name = aerosol_y_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the y direction - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_aerosol_input_MG_radiation) -[iindx1_aer] - standard_name = lower_aerosol_x_interpolation_index - long_name = interpolation low index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_aerosol_input_MG_radiation) -[iindx2_aer] - standard_name = upper_aerosol_x_interpolation_index - long_name = interpolation high index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_aerosol_input_MG_radiation) -[ddx_aer] - standard_name = aerosol_x_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the x direction - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_aerosol_input_MG_radiation) -[jindx1_ci] - standard_name = lower_cloud_nuclei_y_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[jindx2_ci] - standard_name = upper_cloud_nuclei_y_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[ddy_ci] - standard_name = cloud_nuclei_y_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[iindx1_ci] - standard_name = lower_cloud_nuclei_x_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[iindx2_ci] - standard_name = upper_cloud_nuclei_x_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[ddx_ci] - standard_name = cloud_nuclei_x_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics==1) -[jindx1_tau] - standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation - long_name = index1 for weight1 for tau NGWs - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_ugwp_version_1) -[jindx2_tau] - standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation - long_name = index2 for weight2 for tau NGWs - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_ugwp_version_1) -[ddy_j1tau] - standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag - long_name = interpolation weight1 for tau NGWs - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1) -[ddy_j2tau] - standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag - long_name = interpolation weight2 for tau NGWs - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1) - -######################################################################## -[ccpp-table-properties] - name = GFS_tbd_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_tbd_type - type = ddt -[icsdsw] - standard_name = seed_random_numbers_sw - long_name = random seeds for sub-column cloud generators sw - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_lw_clouds_sub_grid_approximation == 2 .or. flag_for_sw_clouds_grid_approximation == 2) -[icsdlw] - standard_name = seed_random_numbers_lw - long_name = random seeds for sub-column cloud generators lw - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_lw_clouds_sub_grid_approximation == 2 .or. flag_for_sw_clouds_grid_approximation == 2) -[tau_amf] - standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag - long_name = ngw_absolute_momentum_flux - units = various - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = various - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys -[h2opl] - standard_name = h2o_forcing - long_name = water forcing data - units = various - dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) - type = real - kind = kind_phys -[hpbl] - standard_name = atmosphere_boundary_layer_thickness - long_name = pbl height - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[in_nm] - standard_name = ice_nucleation_number - long_name = ice nucleation number in MG MP - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[ccn_nm] - standard_name = tendency_of_ccn_activated_number - long_name = tendency of ccn activated number - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[aer_nm] - standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology - long_name = GOCART aerosol climatology number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) - type = real - kind = kind_phys -[imap] - standard_name = map_of_block_column_number_to_global_i_index - long_name = map of local index ix to global index i for this block - units = none - dimensions = (horizontal_loop_extent) - type = integer -[jmap] - standard_name = map_of_block_column_number_to_global_j_index - long_name = map of local index ix to global index j for this block - units = none - dimensions = (horizontal_loop_extent) - type = integer -[rann] - standard_name = random_number_array - long_name = random number array (0-1) - units = none - dimensions = (horizontal_loop_extent,array_dimension_of_random_number) - type = real - kind = kind_phys -[acv] - standard_name = accumulated_lwe_thickness_of_convective_precipitation_amount_cnvc90 - long_name = accumulated convective rainfall amount for cnvc90 only - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[acvb] - standard_name = smallest_cloud_base_vertical_index_encountered_thus_far - long_name = smallest cloud base vertical index encountered thus far - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[acvt] - standard_name = largest_cloud_top_vertical_index_encountered_thus_far - long_name = largest cloud top vertical index encountered thus far - units = index - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtdtnp] - standard_name = tendency_of_air_temperature_to_withold_from_sppt - long_name = temp. change from physics that should not be perturbed by sppt - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_stochastic_physics_perturbations .or. flag_for_global_cellular_automata) -[drain_cpl] - standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling - long_name = change in rain_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_chemistry_coupling) -[dsnow_cpl] - standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling - long_name = change in show_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling .or. flag_for_chemistry_coupling) -[phy_fctd] - standard_name = cloud_base_mass_flux - long_name = cloud base mass flux for CS convection - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent,number_of_cloud_types_CS) - type = real - kind = kind_phys - active = (number_of_cloud_types_CS > 0 .and. flag_for_Chikira_Sugiyama_deep_convection) -[phy_f2d(:,index_for_surface_air_pressure_two_timesteps_back)] - standard_name = surface_air_pressure_two_timesteps_back - long_name = surface air pressure two timesteps back - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (index_for_surface_air_pressure_two_timesteps_back > 0) -[phy_f2d(:,index_for_surface_air_pressure_at_previous_timestep)] - standard_name = surface_air_pressure_at_previous_timestep - long_name = surface air pressure at previous timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (index_for_surface_air_pressure_at_previous_timestep > 0) -[phy_f2d(:,index_for_surface_wind_enhancement_due_to_convection)] - standard_name = surface_wind_enhancement_due_to_convection - long_name = surface wind enhancement due to convection - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (index_for_surface_wind_enhancement_due_to_convection > 0) -[phy_f3d(:,:,index_for_air_temperature_two_timesteps_back)] - standard_name = air_temperature_two_timesteps_back - long_name = air temperature two timesteps back - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_air_temperature_two_timesteps_back > 0) -[phy_f3d(:,:,index_for_specific_humidity_two_timesteps_back)] - standard_name = water_vapor_specific_humidity_two_timesteps_back - long_name = water vapor specific humidity two timesteps back - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_specific_humidity_two_timesteps_back > 0) -[phy_f3d(:,:,index_for_air_temperature_at_previous_timestep)] - standard_name = air_temperature_at_previous_timestep - long_name = air temperature at previous timestep - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_air_temperature_at_previous_timestep > 0) -[phy_f3d(:,:,index_for_specific_humidity_at_previous_timestep)] - standard_name = water_vapor_specific_humidity_at_previous_timestep - long_name = water vapor specific humidity at previous timestep - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_specific_humidity_at_previous_timestep > 0) -[phy_f3d(:,:,index_for_convective_cloud_water_mixing_ratio_in_phy_f3d)] - standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d - long_name = convective cloud water mixing ratio in the phy_f3d array - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_convective_cloud_water_mixing_ratio_in_phy_f3d > 0) -[phy_f3d(:,:,index_for_convective_cloud_cover_in_phy_f3d)] - standard_name = convective_cloud_cover_in_phy_f3d - long_name = convective cloud cover in the phy_f3d array - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_convective_cloud_cover_in_phy_f3d > 0) -[phy_f3d(:,:,index_of_kinematic_buoyancy_flux_from_shoc_in_phy_f3d)] - standard_name = kinematic_buoyancy_flux_from_shoc - long_name = upward kinematic buoyancy flux from the SHOC scheme - units = K m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_of_kinematic_buoyancy_flux_from_shoc_in_phy_f3d > 0) -[phy_f3d(:,:,index_of_atmosphere_heat_diffusivity_from_shoc_in_phy_f3d)] - standard_name = atmosphere_heat_diffusivity_from_shoc - long_name = diffusivity for heat from the SHOC scheme - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_of_atmosphere_heat_diffusivity_from_shoc_in_phy_f3d > 0) -[phy_f3d(:,:,index_of_subgrid_scale_cloud_fraction_from_shoc_in_phy_f3d)] - standard_name = subgrid_scale_cloud_fraction_from_shoc - long_name = subgrid-scale cloud fraction from the SHOC scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_of_subgrid_scale_cloud_fraction_from_shoc_in_phy_f3d > 0) -[phy_f3d(:,:,index_for_cloud_fraction_in_3d_arrays_for_microphysics)] - standard_name = cloud_fraction_for_MG - long_name = cloud fraction used by Morrison-Gettelman MP - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_cloud_fraction_in_3d_arrays_for_microphysics > 0) -[phy_f3d(:,:,index_for_cloud_liquid_water_effective_radius)] - standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um - long_name = eff. radius of cloud liquid water particle in micrometer - units = um - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_cloud_liquid_water_effective_radius > 0) -[phy_f3d(:,:,index_for_ice_effective_radius)] - standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um - long_name = eff. radius of cloud ice water particle in micrometer - units = um - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_ice_effective_radius > 0) -[phy_f3d(:,:,index_for_rain_effective_radius)] - standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um - long_name = effective radius of cloud rain particle in micrometers - units = um - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_rain_effective_radius > 0) -[phy_f3d(:,:,index_for_snow_effective_radius)] - standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um - long_name = effective radius of cloud snow particle in micrometers - units = um - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_snow_effective_radius > 0) -[phy_f3d(:,:,index_for_graupel_effective_radius)] - standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um - long_name = eff. radius of cloud graupel particle in micrometer - units = um - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_graupel_effective_radius > 0) -[forcet] - standard_name = temperature_tendency_due_to_dynamics - long_name = temperature tendency due to dynamics only - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme .or. flag_for_mass_flux_deep_convection_scheme == flag_for_ntiedtke_deep_convection_scheme) -[forceq] - standard_name = moisture_tendency_due_to_dynamics - long_name = moisture tendency due to dynamics only - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme .or. flag_for_mass_flux_deep_convection_scheme == flag_for_ntiedtke_deep_convection_scheme) -[prevst] - standard_name = temperature_from_previous_timestep - long_name = temperature from previous time step - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme .or. flag_for_mass_flux_deep_convection_scheme == flag_for_ntiedtke_deep_convection_scheme) -[prevsq] - standard_name = moisture_from_previous_timestep - long_name = moisture from previous time step - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme .or. flag_for_mass_flux_deep_convection_scheme == flag_for_ntiedtke_deep_convection_scheme) -[cactiv] - standard_name = conv_activity_counter - long_name = convective activity memory - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_mass_flux_deep_convection_scheme == flag_for_gf_deep_convection_scheme) -[CLDFRA_BL] - standard_name = subgrid_cloud_fraction_pbl - long_name = subgrid cloud fraction from PBL scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[QC_BL] - standard_name = subgrid_cloud_water_mixing_ratio_pbl - long_name = subgrid cloud water mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[QI_BL] - standard_name = subgrid_cloud_ice_mixing_ratio_pbl - long_name = subgrid cloud ice mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[el_pbl] - standard_name = mixing_length - long_name = mixing length in meters - units = m - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[Sh3D] - standard_name = stability_function_for_heat - long_name = stability function for heat - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[qke] - standard_name = tke_at_mass_points - long_name = 2 x tke at mass points - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[tsq] - standard_name = t_prime_squared - long_name = temperature fluctuation squared - units = K2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[qsq] - standard_name = q_prime_squared - long_name = water vapor fluctuation squared - units = kg2 kg-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[cov] - standard_name = t_prime_q_prime - long_name = covariance of temperature and moisture - units = K kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[phy_myj_qsfc] - standard_name = surface_specific_humidity_for_MYJ_schemes - long_name = surface air saturation specific humidity for MYJ schemes - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_thz0] - standard_name = potential_temperature_at_viscous_sublayer_top - long_name = potential temperature at viscous sublayer top over water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_qz0] - standard_name = specific_humidity_at_viscous_sublayer_top - long_name = specific humidity at_viscous sublayer top over water - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_uz0] - standard_name = u_wind_component_at_viscous_sublayer_top - long_name = u wind component at viscous sublayer top over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_vz0] - standard_name = v_wind_component_at_viscous_sublayer_top - long_name = v wind component at viscous sublayer top over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_akhs] - standard_name = heat_exchange_coefficient_for_MYJ_schemes - long_name = surface heat exchange_coefficient for MYJ schemes - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_akms] - standard_name = momentum_exchange_coefficient_for_MYJ_schemes - long_name = surface momentum exchange_coefficient for MYJ schemes - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_chkqlm] - standard_name = surface_layer_evaporation_switch - long_name = surface layer evaporation switch - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_elflx] - standard_name = kinematic_surface_latent_heat_flux - long_name = kinematic surface latent heat flux - units = m s-1 kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_a1u] - standard_name = weight_for_momentum_at_viscous_sublayer_top - long_name = weight for momentum at viscous layer top - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_a1t] - standard_name = weight_for_potental_temperature_at_viscous_sublayer_top - long_name = weight for potental temperature at viscous layer top - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) -[phy_myj_a1q] - standard_name = weight_for_specific_humidity_at_viscous_sublayer_top - long_name = weight for Specfic Humidity at viscous layer top - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_myjsfc .or. do_myjpbl) - -######################################################################## -[ccpp-table-properties] - name = GFS_cldprop_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_cldprop_type - type = ddt -[cv] - standard_name = fraction_of_convective_cloud - long_name = fraction of convective cloud - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cvt] - standard_name = pressure_at_top_of_convective_cloud - long_name = convective cloud top pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cvb] - standard_name = pressure_at_bottom_of_convective_cloud - long_name = convective cloud bottom pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - -######################################################################## -[ccpp-table-properties] - name = GFS_radtend_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_radtend_type - type = ddt -[sfcfsw] - standard_name = sw_fluxes_sfc - long_name = sw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcfsw_type -[sfcflw] - standard_name = lw_fluxes_sfc - long_name = lw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcflw_type -[htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky sw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[sfalb] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[coszen] - standard_name = cosine_of_zenith_angle - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[coszdg] - standard_name = daytime_mean_cosz_over_rad_call_period - long_name = daytime mean cosz over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsflw] - standard_name = surface_midlayer_air_temperature_in_longwave_radiation - long_name = surface air temp during lw calculation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step - long_name = clear sky sw heating rates - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[lwhc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step - long_name = clear sky lw heating rates - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[lwhd] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_for_idea - long_name = idea sky lw heating rates - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension,6) - type = real - kind = kind_phys - -######################################################################## -[ccpp-table-properties] - name = GFS_diag_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_diag_type - type = ddt -[fluxr] - standard_name = cumulative_radiation_diagnostic - long_name = time-accumulated 2D radiation-related diagnostic fields - units = various - dimensions = (horizontal_loop_extent,number_of_radiation_diagnostic_variables) - type = real - kind = kind_phys -[topfsw] - standard_name = sw_fluxes_top_atmosphere - long_name = sw radiation fluxes at toa - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topfsw_type -[topflw] - standard_name = lw_fluxes_top_atmosphere - long_name = lw radiation fluxes at top - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topflw_type -[srunoff] - standard_name = surface_runoff - long_name = surface water runoff (from lsm) - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evbsa] - standard_name = cumulative_soil_upward_latent_heat_flux_multiplied_by_timestep - long_name = cumulative soil upward latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evcwa] - standard_name = cumulative_canopy_upward_latent_heat_flu_multiplied_by_timestep - long_name = cumulative canopy upward latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snohfa] - standard_name = cumulative_snow_freezing_rain_upward_latent_heat_flux_multiplied_by_timestep - long_name = cumulative latent heat flux due to snow and frz rain multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[transa] - standard_name = cumulative_transpiration_flux_multiplied_by_timestep - long_name = cumulative total plant transpiration rate multiplied by timestep - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sbsnoa] - standard_name = cumulative_snow_deposition_sublimation_upward_latent_heat_flux_multiplied_by_timestep - long_name = cumulative latent heat flux from snow depo/subl multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snowca] - standard_name = cumulative_surface_snow_area_fraction_multiplied_by_timestep - long_name = cumulative surface snow area fraction multiplied by timestep - units = s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[soilm] - standard_name = soil_moisture_content - long_name = soil moisture - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tmpmin] - standard_name = minimum_temperature_at_2m - long_name = min temperature at 2m height - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tmpmax] - standard_name = maximum_temperature_at_2m - long_name = max temperature at 2m height - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dusfc] - standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc x momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvsfc] - standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc y momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtsfc] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dqsfc] - standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totprcp] - standard_name = accumulated_lwe_thickness_of_precipitation_amount - long_name = accumulated total precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totice] - standard_name = accumulated_lwe_thickness_of_ice_amount - long_name = accumulated ice precipitation - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totsnw] - standard_name = accumulated_lwe_thickness_of_snow_amount - long_name = accumulated snow precipitation - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totgrp] - standard_name = accumulated_lwe_thickness_of_graupel_amount - long_name = accumulated graupel precipitation - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totprcpb] - standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket - long_name = accumulated total precipitation in bucket - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[toticeb] - standard_name = accumulated_lwe_thickness_of_ice_amount_in_bucket - long_name = accumulated ice precipitation in bucket - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totsnwb] - standard_name = accumulated_lwe_thickness_of_snow_amount_in_bucket - long_name = accumulated snow precipitation in bucket - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[totgrpb] - standard_name = accumulated_lwe_thickness_of_graupel_amount_in_bucket - long_name = accumulated graupel precipitation in bucket - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[train] - standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme - long_name = accumulated change of air temperature due to FA MP scheme - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[gflux] - standard_name = cumulative_surface_ground_heat_flux_multiplied_by_timestep - long_name = cumulative groud conductive heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dlwsfc] - standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep - long_name = cumulative surface downwelling LW flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ulwsfc] - standard_name = cumulative_surface_upwelling_longwave_flux_multiplied_by_timestep - long_name = cumulative surface upwelling LW flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[suntim] - standard_name = duration_of_sunshine - long_name = sunshine duration time - units = s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[runoff] - standard_name = total_runoff - long_name = total water runoff - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep] - standard_name = cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep - long_name = cumulative surface upward potential latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cldwrk] - standard_name = cumulative_cloud_work_function - long_name = cumulative cloud work function (valid only with sas) - units = m2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dugwd] - standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag - long_name = vertically integrated u change by OGWD - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvgwd] - standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag - long_name = vertically integrated v change by OGWD - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[psmean] - standard_name = cumulative_surface_pressure_multiplied_by_timestep - long_name = cumulative surface pressure multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cnvprcp] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount - long_name = cumulative convective precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cnvprcpb] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket - long_name = cumulative convective precipitation in bucket - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[spfhmin] - standard_name = minimum_specific_humidity_at_2m - long_name = minimum specific humidity at 2m height - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[spfhmax] - standard_name = maximum_specific_humidity_at_2m - long_name = maximum specific humidity at 2m height - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[u10mmax] - standard_name = maximum_x_wind_at_10m - long_name = maximum x wind at 10 m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[v10mmax] - standard_name = maximum_y_wind_at_10m - long_name = maximum y wind at 10 m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[wind10mmax] - standard_name = maximum_wind_at_10m - long_name = maximum wind speed at 10 m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[u10max] - standard_name = maximum_u_wind_at_10m_over_maximum_hourly_time_interval - long_name = maximum u wind at 10m over maximum hourly time interval - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[v10max] - standard_name = maximum_v_wind_at_10m_over_maximum_hourly_time_interval - long_name = maximum v wind at 10m over maximum hourly time interval - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[spd10max] - standard_name = maximum_wind_at_10m_over_maximum_hourly_time_interval - long_name = maximum wind at 10m over maximum hourly time interval - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rain] - standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total rain at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep - long_name = convective rain at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ice] - standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep - long_name = ice fall at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snow] - standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep - long_name = snow fall at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[graupel] - standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep - long_name = graupel fall at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[u10m] - standard_name = x_wind_at_10m - long_name = 10 meter u wind speed - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[v10m] - standard_name = y_wind_at_10m - long_name = 10 meter v wind speed - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dpt2m] - standard_name = dewpoint_temperature_at_2m - long_name = 2 meter dewpoint temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zlvl] - standard_name = height_above_ground_at_lowest_model_layer - long_name = layer 1 height above ground (not MSL) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[psurf] - standard_name = surface_air_pressure_diag - long_name = surface air pressure diagnostic - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[pwat] - standard_name = column_precipitable_water - long_name = precipitable water - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[t1] - standard_name = air_temperature_at_lowest_model_layer_for_diag - long_name = layer 1 temperature for diag - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[q1] - standard_name = water_vapor_specific_humidity_at_lowest_model_layer_for_diag - long_name = layer 1 specific humidity for diag - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[u1] - standard_name = x_wind_at_lowest_model_layer_for_diag - long_name = layer 1 x wind for diag - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[v1] - standard_name = y_wind_at_lowest_model_layer_for_diag - long_name = layer 1 y wind for diag - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air - long_name = thermal exchange coefficient - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cmm] - standard_name = surface_drag_wind_speed_for_momentum_in_air - long_name = momentum exchange coefficient - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dlwsfci] - standard_name = surface_downwelling_longwave_flux - long_name = surface downwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ulwsfci] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dswsfci] - standard_name = surface_downwelling_shortwave_flux - long_name = surface downwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[nswsfci] - standard_name = surface_net_downwelling_shortwave_flux - long_name = surface net downwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uswsfci] - standard_name = surface_upwelling_shortwave_flux - long_name = surface upwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dusfci] - standard_name = instantaneous_surface_x_momentum_flux_for_diag - long_name = instantaneous sfc x momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvsfci] - standard_name = instantaneous_surface_y_momentum_flux_for_diag - long_name = instantaneous sfc y momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtsfci] - standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag - long_name = instantaneous sfc sensible heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dqsfci] - standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag - long_name = instantaneous sfc latent heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gfluxi] - standard_name = instantaneous_surface_ground_heat_flux - long_name = instantaneous sfc ground heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[epi] - standard_name = instantaneous_surface_potential_evaporation - long_name = instantaneous sfc potential evaporation - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[smcwlt2] - standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point - long_name = wilting point (volumetric) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[smcref2] - standard_name = threshold_volume_fraction_of_condensed_water_in_soil - long_name = soil moisture threshold (volumetric) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sr] - standard_name = ratio_of_snowfall_to_rainfall - long_name = snow ratio: ratio of snow to total precipitation (explicit only) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[wet1] - standard_name = normalized_soil_wetness - long_name = normalized soil wetness - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (.not. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[tdomr] - standard_name = dominant_rain_type - long_name = dominant rain type - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tdomzr] - standard_name = dominant_freezing_rain_type - long_name = dominant freezing rain type - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tdomip] - standard_name = dominant_sleet_type - long_name = dominant sleet type - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tdoms] - standard_name = dominant_snow_type - long_name = dominant snow type - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[skebu_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind_flipped - long_name = weights for stochastic skeb perturbation of x wind, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[skebv_wts] - standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind_flipped - long_name = weights for stochastic skeb perturbation of y wind, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[sppt_wts] - standard_name = weights_for_stochastic_sppt_perturbation_flipped - long_name = weights for stochastic sppt perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[shum_wts] - standard_name = weights_for_stochastic_shum_perturbation_flipped - long_name = weights for stochastic shum perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[sfc_wts] - standard_name = weights_for_stochastic_surface_physics_perturbation_flipped - long_name = weights for stochastic surface physics perturbation, flipped - units = none - dimensions = (horizontal_loop_extent,number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys -[zmtnblck] - standard_name = level_of_dividing_streamline - long_name = level of the dividing streamline - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[du3dt(:,:,1)] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,2)] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,3)] - standard_name = cumulative_change_in_x_wind_due_to_deep_convection - long_name = cumulative change in x wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,4)] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in x wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,5)] - standard_name = cumulative_change_in_x_wind_due_to_rayleigh_damping - long_name = cumulative change in x wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,6)] - standard_name = cumulative_change_in_x_wind_due_to_shallow_convection - long_name = cumulative change in x wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,7)] - standard_name = cumulative_change_in_x_wind_due_to_physics - long_name = cumulative change in x wind due to physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[du3dt(:,:,8)] - standard_name = cumulative_change_in_x_wind_due_to_non_physics_processes - long_name = cumulative change in x wind due to non-physics processes - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,1)] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,2)] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,3)] - standard_name = cumulative_change_in_y_wind_due_to_deep_convection - long_name = cumulative change in y wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,4)] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in y wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dv3dt(:,:,5)] - standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping - long_name = cumulative change in y wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,6)] - standard_name = cumulative_change_in_y_wind_due_to_shallow_convection - long_name = cumulative change in y wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,7)] - standard_name = cumulative_change_in_y_wind_due_to_physics - long_name = cumulative change in y wind due to physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dv3dt(:,:,8)] - standard_name = cumulative_change_in_y_wind_due_to_non_physics_processes - long_name = cumulative change in y wind due to non-physics processes - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,1)] - standard_name = cumulative_change_in_temperature_due_to_longwave_radiation - long_name = cumulative change in temperature due to longwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,2)] - standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation - long_name = cumulative change in temperature due to shortwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,3)] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,4)] - standard_name = cumulative_change_in_temperature_due_to_deep_convection - long_name = cumulative change in temperature due to deep convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,5)] - standard_name = cumulative_change_in_temperature_due_to_shallow_convection - long_name = cumulative change in temperature due to shallow convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,6)] - standard_name = cumulative_change_in_temperature_due_to_microphysics - long_name = cumulative change in temperature due to microphysics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,7)] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,8)] - standard_name = cumulative_change_in_temperature_due_to_rayleigh_damping - long_name = cumulative change in temperature due to Rayleigh damping - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,9)] - standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag - long_name = cumulative change in temperature due to convective gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,10)] - standard_name = cumulative_change_in_temperature_due_to_physics - long_name = cumulative change in temperature due to physics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dt3dt(:,:,11)] - standard_name = cumulative_change_in_temperature_due_to_non_physics_processes - long_name = cumulative change in temperature due to non-physics processed - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D) -[dq3dt(:,:,1)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,2)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection - long_name = cumulative change in water vapor specific humidity due to deep convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,3)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection - long_name = cumulative change in water vapor specific humidity due to shallow convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,4)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics - long_name = cumulative change in water vapor specific humidity due to microphysics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,5)] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,6)] - standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate - long_name = cumulative change in ozone concentration due to production and loss rate - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,7)] - standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio - long_name = cumulative change in ozone concentration due to ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,8)] - standard_name = cumulative_change_in_ozone_concentration_due_to_temperature - long_name = cumulative change in ozone concentration due to temperature - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,9)] - standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column - long_name = cumulative change in ozone concentration due to overhead ozone column - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,10)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_physics - long_name = cumulative change in water vapor specific humidity due to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,11)] - standard_name = cumulative_change_in_ozone_concentration_due_to_physics - long_name = cumulative change in ozone concentration due to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,12)] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_non_physics_processes - long_name = cumulative change in water vapor specific humidity due to non-physics processes - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[dq3dt(:,:,13)] - standard_name = cumulative_change_in_ozone_concentration_due_to_non_physics_processes - long_name = cumulative change in ozone_concentration due to non-physics processes - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_diagnostics_3D .and. flag_tracer_diagnostics_3D) -[refdmax] - standard_name = maximum_reflectivity_at_1km_agl_over_maximum_hourly_time_interval - long_name = maximum reflectivity at 1km agl over maximum hourly time interval - units = dBZ - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[refdmax263k] - standard_name = maximum_reflectivity_at_minus10c_over_maximum_hourly_time_interval - long_name = maximum reflectivity at minus10c over maximum hourly time interval - units = dBZ - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[t02max] - standard_name = maximum_temperature_at_2m_over_maximum_hourly_time_interval - long_name = maximum temperature at 2m over maximum hourly time interval - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[t02min] - standard_name = minimum_temperature_at_2m_over_maximum_hourly_time_interval - long_name = minumum temperature at 2m over maximum hourly time interval - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rh02max] - standard_name = maximum_relative_humidity_at_2m_over_maximum_hourly_time_interval - long_name = maximum relative humidity at 2m over maximum hourly time interval - units = % - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rh02min] - standard_name = minimum_relative_humidity_at_2m_over_maximum_hourly_time_interval - long_name = minumum relative humidity at 2m over maximum hourly time interval - units = % - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[upd_mf] - standard_name = cumulative_atmosphere_updraft_convective_mass_flux - long_name = cumulative updraft mass flux - units = kg m-1 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dwn_mf] - standard_name = cumulative_atmosphere_downdraft_convective_mass_flux - long_name = cumulative downdraft mass flux - units = kg m-1 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[det_mf] - standard_name = cumulative_atmosphere_detrainment_convective_mass_flux - long_name = cumulative detrainment mass flux - units = kg m-1 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[refl_10cm] - standard_name = radar_reflectivity_10cm - long_name = instantaneous refl_10cm - units = dBZ - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dkt] - standard_name = atmosphere_heat_diffusivity - long_name = atmospheric heat diffusivity - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dku] - standard_name = atmosphere_momentum_diffusivity - long_name = atmospheric momentum diffusivity - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[cldfra] - standard_name = instantaneous_3d_cloud_fraction - long_name = instantaneous 3D cloud fraction for all MPs - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[ndust] - standard_name = number_of_dust_bins_for_diagnostics - long_name = number of dust bins for diagnostics - units = count - dimensions = () - type = integer -[nseasalt] - standard_name = number_of_seasalt_bins_for_diagnostics - long_name = number of seasalt bins for diagnostics - units = count - dimensions = () - type = integer -[ntchmdiag] - standard_name = number_of_chemical_tracers_for_diagnostics - long_name = number of chemical tracers for diagnostic output - units = count - dimensions = () - type = integer -[duem] - standard_name = instantaneous_dust_emission_flux - long_name = instantaneous dust emission flux - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_dust_bins_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_dust_bins_for_diagnostics > 0) -[ssem] - standard_name = instantaneous_seasalt_emission_flux - long_name = instantaneous sea salt emission flux - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_seasalt_bins_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_seasalt_bins_for_diagnostics > 0) -[sedim] - standard_name = instantaneous_sedimentation - long_name = instantaneous sedimentation - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_chemical_tracers_for_diagnostics > 0) -[drydep] - standard_name = instantaneous_dry_deposition - long_name = instantaneous dry deposition - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_chemical_tracers_for_diagnostics > 0) -[wetdpl] - standard_name = instantaneous_large_scale_wet_deposition - long_name = instantaneous large-scale wet deposition - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_chemical_tracers_for_diagnostics > 0) -[wetdpc] - standard_name = instantaneous_convective_scale_wet_deposition - long_name = instantaneous convective-scale wet deposition - units = kg m-2 s-1 - dimensions = (horizonal_dimension,number_of_chemical_tracers_for_diagnostics) - type = real - kind = kind_phys - active = (number_of_chemical_tracers_for_diagnostics > 0) -[abem] - standard_name = instantaneous_anthopogenic_and_biomass_burning_emissions - long_name = instantaneous anthopogenic and biomass burning emissions for black carbon, organic carbon, and sulfur dioxide - units = ug m-2 s-1 - dimensions = (horizontal_loop_extent,6) - type = real - kind = kind_phys -[aecm] - standard_name = instantaneous_aerosol_column_mass_densities - long_name = instantaneous aerosol column mass densities for pm2.5, black carbon, organic carbon, sulfate, dust, sea salt - units = g m-2 - dimensions = (horizontal_loop_extent,6) - type = real - kind = kind_phys -[edmf_a] - standard_name = emdf_updraft_area - long_name = updraft area from mass flux scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[edmf_w] - standard_name = emdf_updraft_vertical_velocity - long_name = updraft vertical velocity from mass flux scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[edmf_qt] - standard_name = emdf_updraft_total_water - long_name = updraft total water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[edmf_thl] - standard_name = emdf_updraft_theta_l - long_name = updraft theta-l from mass flux scheme - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[edmf_ent] - standard_name = emdf_updraft_entrainment_rate - long_name = updraft entranment rate from mass flux scheme - units = s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[edmf_qc] - standard_name = emdf_updraft_cloud_water - long_name = updraft cloud water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[sub_thl] - standard_name = theta_subsidence_tendency - long_name = updraft theta subsidence tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[sub_sqv] - standard_name = water_vapor_subsidence_tendency - long_name = updraft water vapor subsidence tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[det_thl] - standard_name = theta_detrainment_tendency - long_name = updraft theta detrainment tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[det_sqv] - standard_name = water_vapor_detrainment_tendency - long_name = updraft water vapor detrainment tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf .and. (mynn_output_flag .ne. 0)) -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count - dimensions = (horizontal_loop_extent) - type = integer - active = (do_mynnedmf) -[maxMF] - standard_name = maximum_mass_flux - long_name = maximum mass flux within a column - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (do_mynnedmf) -[ktop_shallow] - standard_name = k_level_of_highest_reaching_plume - long_name = k-level of highest reaching plume - units = count - dimensions = (horizontal_loop_extent) - type = integer -[ktop_plume] - standard_name = k_level_of_highest_plume - long_name = k-level of highest plume - units = count - dimensions = (horizontal_loop_extent) - type = integer - active = (do_mynnedmf) -[exch_h] - standard_name = atmosphere_heat_diffusivity_for_mynnpbl - long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[exch_m] - standard_name = atmosphere_momentum_diffusivity_for_mynnpbl - long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (do_mynnedmf) -[zmtb] - standard_name = time_integral_of_height_of_mountain_blocking - long_name = time integral of height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zlwb] - standard_name = time_integral_of_height_of_low_level_wave_breaking - long_name = time integral of height of drag due to low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zogw] - standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave - long_name = time integral of height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_tofd] - standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag - long_name = time integral of momentum flux due to TOFD - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_mtb] - standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag - long_name = time integral of momentum flux due to mountain blocking drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ogw] - standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag - long_name = time integral of momentum flux due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ngw] - standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave - long_name = time integral of momentum flux due to nonstationary gravity waves - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[du3dt_mtb] - standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag - long_name = time integral of change in x wind due to mountain blocking drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (diag_ugwp_flag) -[du3dt_ogw] - standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = time integral of change in x wind due to orographic gw drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (diag_ugwp_flag) -[du3dt_tms] - standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag - long_name = time integral of change in x wind due to TOFD - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (diag_ugwp_flag) -[du3dt_ngw] - standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave - long_name = time integral of change in x wind due to NGW - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (diag_ugwp_flag) -[dudt_gw] - standard_name = tendency_of_x_wind_due_to_gravity_wave_drag - long_name = zonal wind tendency due to all GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dvdt_gw] - standard_name = tendency_of_y_wind_due_to_gravity_wave_drag - long_name = meridional wind tendency due to all GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dtdt_gw] - standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag - long_name = air temperature tendency due to all GWs - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[kdis_gw] - standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag - long_name = eddy mixing due to all GWs - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dudt_ogw] - standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag - long_name = x momentum tendency from meso scale ogw - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dvdt_ogw] - standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag - long_name = y momentum tendency from meso scale ogw - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[du_ogwcol] - standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag - long_name = integrated x momentum flux from meso scale ogw - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dv_ogwcol] - standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag - long_name = integrated y momentum flux from meso scale ogw - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dudt_obl] - standard_name = tendency_of_x_momentum_due_to_blocking_drag - long_name = x momentum tendency from blocking drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dvdt_obl] - standard_name = tendency_of_y_momentum_due_to_blocking_drag - long_name = y momentum tendency from blocking drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[du_oblcol] - standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag - long_name = integrated x momentum flux from blocking drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dv_oblcol] - standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag - long_name = integrated y momentum flux from blocking drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dudt_oss] - standard_name = tendency_of_x_momentum_due_to_small_scale_gravity_wave_drag - long_name = x momentum tendency from small scale gwd - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dvdt_oss] - standard_name = tendency_of_y_momentum_due_to_small_scale_gravity_wave_drag - long_name = y momentum tendency from small scale gwd - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[du_osscol] - standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag - long_name = integrated x momentum flux from small scale gwd - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dv_osscol] - standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag - long_name = integrated y momentum flux from small scale gwd - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dudt_ofd] - standard_name = tendency_of_x_momentum_due_to_form_drag - long_name = x momentum tendency from form drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dvdt_ofd] - standard_name = tendency_of_y_momentum_due_to_form_drag - long_name = y momentum tendency from form drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[du_ofdcol] - standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag - long_name = integrated x momentum flux from form drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dv_ofdcol] - standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag - long_name = integrated y momentum flux from form drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dv3dt_ngw] - standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave - long_name = time integral of change in y wind due to NGW - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (diag_ugwp_flag) -[aux2d] - standard_name = auxiliary_2d_arrays - long_name = auxiliary 2d arrays to output (for debugging) - units = none - dimensions = (horizontal_loop_extent,number_of_3d_auxiliary_arrays) - type = real - kind = kind_phys - active = (number_of_2d_auxiliary_arrays > 0) -[aux3d] - standard_name = auxiliary_3d_arrays - long_name = auxiliary 3d arrays to output (for debugging) - units = none - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_3d_auxiliary_arrays) - type = real - kind = kind_phys - active = (number_of_3d_auxiliary_arrays > 0) - -######################################################################## -[ccpp-table-properties] - name = GFS_interstitial_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_interstitial_type - type = ddt -[qv_r] - standard_name = humidity_mixing_ratio - long_name = the ratio of the mass of water vapor to the mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[qc_r] - standard_name = cloud_liquid_water_mixing_ratio - long_name = the ratio of the mass of liquid water to the mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[qr_r] - standard_name = cloud_rain_water_mixing_ratio - long_name = the ratio of the mass rain water to the mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[qi_r] - standard_name = cloud_ice_mixing_ratio - long_name = the ratio of the mass of ice to the mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[qs_r] - standard_name = cloud_snow_mixing_ratio - long_name = the ratio of the mass of snow to mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[qg_r] - standard_name = mass_weighted_rime_factor_mixing_ratio - long_name = the ratio of the mass of rime factor to mass of dry air - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[f_ice] - standard_name = fraction_of_ice_water_cloud - long_name = fraction of ice water cloud - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[f_rain] - standard_name = fraction_of_rain_water_cloud - long_name = fraction of rain water cloud - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[f_rimef] - standard_name = rime_factor - long_name = rime factor - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[cwm] - standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics - long_name = total cloud condensate mixing ratio (except water vapor) updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_fer_hires_microphysics_scheme) -[adjsfculw_water] - standard_name = surface_upwelling_longwave_flux_over_water_interstitial - long_name = surface upwelling longwave flux at current time over water (temporary use as interstitial) - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjsfculw_land] - standard_name = surface_upwelling_longwave_flux_over_land_interstitial - long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjsfculw_ice] - standard_name = surface_upwelling_longwave_flux_over_ice_interstitial - long_name = surface upwelling longwave flux at current time over ice (temporary use as interstitial) - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirbmd] - standard_name = surface_downwelling_direct_near_infrared_shortwave_flux - long_name = surface downwelling beam near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirbmu] - standard_name = surface_upwelling_direct_near_infrared_shortwave_flux - long_name = surface upwelling beam near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirdfd] - standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux - long_name = surface downwelling diffuse near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjnirdfu] - standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux - long_name = surface upwelling diffuse near-infrared shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisbmd] - standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux - long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisbmu] - standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux - long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisdfu] - standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux - long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[adjvisdfd] - standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux - long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[aerodp] - standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles - long_name = vertical integrated optical depth for various aerosol species - units = none - dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[alpha] - standard_name = cloud_overlap_decorrelation_parameter - long_name = cloud overlap decorrelation parameter for RRTMG (but not for RRTMGP) - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[bexp1d] - standard_name = perturbation_of_soil_type_b_parameter - long_name = perturbation of soil type "b" parameter - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[canopy_save] - standard_name = canopy_water_amount_save - long_name = canopy water amount before entering a physics scheme - units = kg m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[cd] - standard_name = surface_drag_coefficient_for_momentum_in_air - long_name = surface exchange coeff for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_water] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_water - long_name = surface exchange coeff for momentum over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_land] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_land - long_name = surface exchange coeff for momentum over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cd_ice] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice - long_name = surface exchange coeff for momentum over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air - long_name = surface exchange coeff heat & moisture - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_water] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water - long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_land] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land - long_name = surface exchange coeff heat & moisture over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cdq_ice] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice - long_name = surface exchange coeff heat & moisture over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_water] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water - long_name = thermal exchange coefficient over water - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_land] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land - long_name = thermal exchange coefficient over land - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chh_ice] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice - long_name = thermal exchange coefficient over ice - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[chk_land] - standard_name = surface_conductance_for_heat_and_moisture_in_air_over_land - long_name = surface conductance for heat & moisture over land - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[cf_upi] - standard_name = convective_cloud_fraction_for_microphysics - long_name = convective cloud fraction for microphysics - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[clcn] - standard_name = convective_cloud_volume_fraction - long_name = convective cloud volume fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cldf] - standard_name = cloud_area_fraction - long_name = fraction of grid box area in which updrafts occur - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_loop_extent,5) - type = real - kind = kind_phys -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[cldtausw] - standard_name = cloud_optical_depth_layers_at_0p55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[cld1d] - standard_name = cloud_work_function - long_name = cloud work function - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[clouds(:,:,1)] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,2)] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,3)] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,4)] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,5)] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,6)] - standard_name = cloud_rain_water_path - long_name = cloud rain water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,7)] - standard_name = mean_effective_radius_for_rain_drop - long_name = mean effective radius for rain drop - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,8)] - standard_name = cloud_snow_water_path - long_name = cloud snow water path - units = g m-2 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clouds(:,:,9)] - standard_name = mean_effective_radius_for_snow_flake - long_name = mean effective radius for snow flake - units = um - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[clw] - standard_name = convective_transportable_tracers - long_name = array to contain cloud water and other convective trans. tracers - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) - type = real - kind = kind_phys -[clw(:,:,1)] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[clw(:,:,2)] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[clw(:,:,index_for_turbulent_kinetic_energy_convective_transport_tracer)] - standard_name = turbulent_kinetic_energy_convective_transport_tracer - long_name = turbulent kinetic energy in the convectively transported tracer array - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[clx] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height - long_name = frac. of grid box with by subgrid orography higher than critical height - units = frac - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys -[cmc] - standard_name = canopy_water_amount_in_m - long_name = canopy water amount in m - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[clxss] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale - long_name = frac. of grid box with by subgrid orography higher than critical height small scale - units = frac - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys - active = (gwd_opt == 3 .or. gwd_opt == 33) -[cmm_water] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water - long_name = momentum exchange coefficient over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cmm_land] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land - long_name = momentum exchange coefficient over land - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cmm_ice] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice - long_name = momentum exchange coefficient over ice - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cnv_dqldt] - standard_name = tendency_of_cloud_water_due_to_convective_microphysics - long_name = tendency of cloud water due to convective microphysics - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cnv_fice] - standard_name = ice_fraction_in_convective_tower - long_name = ice fraction in convective tower - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cnv_mfd] - standard_name = detrained_mass_flux - long_name = detrained mass flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cnv_ndrop] - standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment - long_name = droplet number concentration in convective detrainment - units = m-3 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cnv_nice] - standard_name = number_concentration_of_ice_crystals_for_detrainment - long_name = crystal number concentration in convective detrainment - units = m-3 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[cnvc] - standard_name = convective_cloud_cover - long_name = convective cloud cover - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[cnvw] - standard_name = convective_cloud_water_mixing_ratio - long_name = moist convective cloud water mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[ctei_r] - standard_name = cloud_top_entrainment_instability_value - long_name = cloud top entrainment instability value - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ctei_rml] - standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria - long_name = grid sensitive critical cloud top entrainment instability criteria - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[cumabs] - standard_name = maximum_column_heating_rate - long_name = maximum heating rate in column - units = K s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dd_mf] - standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux - long_name = (downdraft mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[del] - standard_name = air_pressure_difference_between_midlayers - long_name = air pressure difference between midlayers - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[del_gz] - standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature - long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature - units = m2 s-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys -[delr] - standard_name = layer_pressure_thickness_for_radiation - long_name = layer pressure thickness on radiation levels - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[dlength] - standard_name = characteristic_grid_length_scale - long_name = representative horizontal length scale of grid box - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dqdt] - standard_name = tendency_of_tracers_due_to_model_physics - long_name = updated tendency of the tracers due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys -[dqdt(:,:,index_for_water_vapor)] - standard_name = tendency_of_water_vapor_specific_humidity_due_to_model_physics - long_name = water vapor specific humidity tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_liquid_cloud_condensate)] - standard_name = tendency_of_liquid_cloud_water_mixing_ratio_due_to_model_physics - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_ice_cloud_condensate)] - standard_name = tendency_of_ice_cloud_water_mixing_ratio_due_to_model_physics - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_ozone)] - standard_name = tendency_of_ozone_mixing_ratio_due_to_model_physics - long_name = ozone mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_liquid_cloud_number_concentration)] - standard_name = tendency_of_cloud_droplet_number_concentration_due_to_model_physics - long_name = number concentration of cloud droplets (liquid) tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_liquid_cloud_number_concentration > 0) -[dqdt(:,:,index_for_ice_cloud_number_concentration)] - standard_name = tendency_of_ice_number_concentration_due_to_model_physics - long_name = number concentration of ice tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_water_friendly_aerosols)] - standard_name = tendency_of_water_friendly_aerosol_number_concentration_due_to_model_physics - long_name = number concentration of water-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_water_friendly_aerosols > 0) -[dqdt(:,:,index_for_ice_friendly_aerosols)] - standard_name = tendency_of_ice_friendly_aerosol_number_concentration_due_to_model_physics - long_name = number concentration of ice-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (index_for_ice_friendly_aerosols > 0) -[dqdt(:,:,index_for_rain_water)] - standard_name = tendency_of_rain_water_mixing_ratio_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_loop_extent,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 = 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_graupel)] - standard_name = tendency_of_graupel_mixing_ratio_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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqdt(:,:,index_for_turbulent_kinetic_energy)] - standard_name = tendency_of_turbulent_kinetic_energy_due_to_model_physics - long_name = turbulent kinetic energy tendency due to model physics - units = J s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dqsdt2] - standard_name = saturation_specific_humidity_slope - long_name = saturation specific humidity slope at lowest model layer - units = K-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[dqsfc1] - standard_name = instantaneous_surface_upward_latent_heat_flux - long_name = surface upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[drain] - standard_name = subsurface_runoff_flux - long_name = subsurface runoff flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[drain_in_m_sm1] - standard_name = subsurface_runoff_flux_in_m_sm1 - long_name = subsurface runoff flux in m s-1 - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[dtdt] - standard_name = tendency_of_air_temperature_due_to_model_physics - long_name = air temperature tendency due to model physics - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dtsfc1] - standard_name = instantaneous_surface_upward_sensible_heat_flux - long_name = surface upward sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dtzm] - standard_name = mean_change_over_depth_in_sea_water_temperature - long_name = mean of dT(z) (zsea1 to zsea2) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dt_mf] - standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux - long_name = (detrainment mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dudt] - standard_name = tendency_of_x_wind_due_to_model_physics - long_name = zonal wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dusfcg] - standard_name = instantaneous_x_stress_due_to_gravity_wave_drag - long_name = zonal surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dusfc1] - standard_name = instantaneous_surface_x_momentum_flux - long_name = x momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvdftra] - standard_name = tendency_of_vertically_diffused_tracer_concentration - long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys -[dvdt] - standard_name = tendency_of_y_wind_due_to_model_physics - long_name = meridional wind tendency due to model physics - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dvsfcg] - standard_name = instantaneous_y_stress_due_to_gravity_wave_drag - long_name = meridional surface stress due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dvsfc1] - standard_name = instantaneous_surface_y_momentum_flux - long_name = y momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dzlyr] - standard_name = layer_thickness_for_radiation - long_name = layer thickness on radiation levels - units = km - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[elvmax] - standard_name = maximum_subgrid_orography - long_name = maximum of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semis_water] - standard_name = surface_longwave_emissivity_over_water_interstitial - long_name = surface lw emissivity in fraction over water (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semis_land] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semis_ice] - standard_name = surface_longwave_emissivity_over_ice_interstitial - long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d] - standard_name = surface_upward_potential_latent_heat_flux - long_name = surface upward potential latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_water] - standard_name = surface_upward_potential_latent_heat_flux_over_water - long_name = surface upward potential latent heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_land] - standard_name = surface_upward_potential_latent_heat_flux_over_land - long_name = surface upward potential latent heat flux over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ep1d_ice] - standard_name = surface_upward_potential_latent_heat_flux_over_ice - long_name = surface upward potential latent heat flux over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evapq] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux reduced by surface roughness - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_water] - standard_name = kinematic_surface_upward_latent_heat_flux_over_water - long_name = kinematic surface upward latent heat flux over water - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_land] - standard_name = kinematic_surface_upward_latent_heat_flux_over_land - long_name = kinematic surface upward latent heat flux over land - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evap_ice] - standard_name = kinematic_surface_upward_latent_heat_flux_over_ice - long_name = kinematic surface upward latent heat flux over ice - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evbs] - standard_name = soil_upward_latent_heat_flux - long_name = soil upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[evcw] - standard_name = canopy_upward_latent_heat_flux - long_name = canopy upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[faerlw] - standard_name = aerosol_optical_properties_for_longwave_bands_01_16 - long_name = aerosol optical properties for longwave bands 01-16 - units = various - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation,number_of_aerosol_output_fields_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,1)] - standard_name = aerosol_optical_depth_for_longwave_bands_01_16 - long_name = aerosol optical depth for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,2)] - standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 - long_name = aerosol single scattering albedo for longwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faerlw(:,:,:,3)] - standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 - long_name = aerosol asymmetry parameter for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys -[faersw] - standard_name = aerosol_optical_properties_for_shortwave_bands_01_16 - long_name = aerosol optical properties for shortwave bands 01-16 - units = various - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation,number_of_aerosol_output_fields_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,1)] - standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 - long_name = aerosol optical depth for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,2)] - standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 - long_name = aerosol single scattering albedo for shortwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[faersw(:,:,:,3)] - standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 - long_name = aerosol asymmetry parameter for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys -[ffhh_water] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_water - long_name = Monin-Obukhov similarity function for heat over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffhh_land] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_land - long_name = Monin-Obukhov similarity function for heat over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffhh_ice] - standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice - long_name = Monin-Obukhov similarity function for heat over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m - long_name = Monin-Obukhov similarity parameter for heat at 2m - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_water] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_water - long_name = Monin-Obukhov similarity parameter for heat at 2m over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_land] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land - long_name = Monin-Obukhov similarity parameter for heat at 2m over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fh2_ice] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice - long_name = Monin-Obukhov similarity parameter for heat at 2m over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[flag_guess] - standard_name = flag_for_guess_run - long_name = flag for guess run - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[flag_lsm] - standard_name = flag_for_calling_land_surface_model - long_name = flag for calling land surface model - units = flag - dimensions = (horizontal_loop_extent) - type = logical - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[flag_lsm_glacier] - standard_name = flag_for_calling_land_surface_model_glacier - long_name = flag for calling land surface model over glacier - units = flag - dimensions = (horizontal_loop_extent) - type = logical - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[ffmm_water] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water - long_name = Monin-Obukhov similarity function for momentum over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffmm_land] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land - long_name = Monin-Obukhov similarity function for momentum over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ffmm_ice] - standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice - long_name = Monin-Obukhov similarity function for momentum over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m - long_name = Monin-Obukhov similarity parameter for momentum at 10m - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_water] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water - long_name = Monin-Obukhov similarity parameter for momentum at 10m over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_land] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land - long_name = Monin-Obukhov similarity parameter for momentum at 10m over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fm10_ice] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice - long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[frain] - standard_name = dynamics_to_physics_timestep_ratio - long_name = ratio of dynamics timestep to physics timestep - units = none - dimensions = () - type = real - kind = kind_phys -[frland] - standard_name = land_area_fraction_for_microphysics - long_name = land area fraction used in microphysics schemes - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[fscav] - standard_name = fraction_of_tracer_scavenged - long_name = fraction of the tracer (aerosols) that is scavenged by convection - units = km-1 - dimensions = (number_of_tracers_scavenged) - type = real - kind = kind_phys -[fswtr] - standard_name = fraction_of_cloud_top_water_scavenged - long_name = fraction of the tracer (cloud top water) that is scavenged by convection - units = km-1 - dimensions = (number_of_tracers_scavenged) - type = real - kind = kind_phys -[gabsbdlw] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground - long_name = total sky surface downward longwave flux absorbed by the ground - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_water] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water - long_name = total sky surface downward longwave flux absorbed by the ground over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_land] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land - long_name = total sky surface downward longwave flux absorbed by the ground over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gabsbdlw_ice] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice - long_name = total sky surface downward longwave flux absorbed by the ground over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamma] - standard_name = anisotropy_of_subgrid_orography - long_name = anisotropy of subgrid orography - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamq] - standard_name = countergradient_mixing_term_for_water_vapor - long_name = countergradient mixing term for water vapor - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gamt] - standard_name = countergradient_mixing_term_for_temperature - long_name = countergradient mixing term for temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gasvmr(:,:,1)] - standard_name = volume_mixing_ratio_co2 - long_name = volume mixing ratio co2 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,2)] - standard_name = volume_mixing_ratio_n2o - long_name = volume mixing ratio no2 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,3)] - standard_name = volume_mixing_ratio_ch4 - long_name = volume mixing ratio ch4 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,4)] - standard_name = volume_mixing_ratio_o2 - long_name = volume mixing ratio o2 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,5)] - standard_name = volume_mixing_ratio_co - long_name = volume mixing ratio co - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,6)] - standard_name = volume_mixing_ratio_cfc11 - long_name = volume mixing ratio cfc11 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,7)] - standard_name = volume_mixing_ratio_cfc12 - long_name = volume mixing ratio cfc12 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,8)] - standard_name = volume_mixing_ratio_cfc22 - long_name = volume mixing ratio cfc22 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,9)] - standard_name = volume_mixing_ratio_ccl4 - long_name = volume mixing ratio ccl4 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gasvmr(:,:,10)] - standard_name = volume_mixing_ratio_cfc113 - long_name = volume mixing ratio cfc113 - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[gflx] - standard_name = upward_heat_flux_in_soil - long_name = soil heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_water] - standard_name = upward_heat_flux_in_soil_over_water - long_name = soil heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_land] - standard_name = upward_heat_flux_in_soil_over_land - long_name = soil heat flux over land - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[gflx_ice] - standard_name = upward_heat_flux_in_soil_over_ice - long_name = soil heat flux over ice - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[graupelmp] - standard_name = lwe_thickness_of_graupel_amount - long_name = explicit graupel fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_gfdl_microphysics_scheme .or. flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme) -[gwdcu] - standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag - long_name = zonal wind tendency due to convective gravity wave drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[gwdcv] - standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag - long_name = meridional wind tendency due to convective gravity wave drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[hefac] - standard_name = surface_upward_latent_heat_flux_reduction_factor - long_name = surface upward latent heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hffac] - standard_name = surface_upward_sensible_heat_flux_reduction_factor - long_name = surface upward sensible heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflxq] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux reduced by surface roughness - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_water] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_water - long_name = kinematic surface upward sensible heat flux over water - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_land] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_land - long_name = kinematic surface upward sensible heat flux over land - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[hflx_ice] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice - long_name = kinematic surface upward sensible heat flux over ice - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[htlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels - long_name = total sky heating rate due to longwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = clear sky heating rate due to longwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels - long_name = total sky heating rate due to shortwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[htsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = clear sky heating rates due to shortwave radiation - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[icemp] - standard_name = lwe_thickness_of_ice_amount - long_name = explicit ice fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_gfdl_microphysics_scheme .or. flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme) -[dry] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[lake] - standard_name = flag_nonzero_lake_surface_fraction - long_name = flag indicating presence of some lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[ocean] - standard_name = flag_nonzero_ocean_surface_fraction - long_name = flag indicating presence of some ocean surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer -[islmsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[islmsk_cice] - standard_name = sea_land_ice_mask_cice - long_name = sea/land/ice mask cice (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[itc] - standard_name = number_of_aerosol_tracers_for_convection - long_name = number of aerosol tracers transported/scavenged by convection - units = count - dimensions = () - type = integer -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical -[kb] - standard_name = vertical_index_difference_between_layer_and_lower_bound - long_name = vertical index difference between layer and lower bound - units = index - dimensions = () - type = integer -[kbot] - standard_name = vertical_index_at_cloud_base - long_name = vertical index at cloud base - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kcnv] - standard_name = flag_deep_convection - long_name = flag indicating whether convection occurs in column (0 or 1) - units = flag - dimensions = (horizontal_loop_extent) - type = integer -[kd] - standard_name = vertical_index_difference_between_inout_and_local - long_name = vertical index difference between in/out and local - units = index - dimensions = () - type = integer -[kinver] - standard_name = index_of_highest_temperature_inversion - long_name = index of highest temperature inversion - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kpbl] - standard_name = vertical_index_at_top_of_atmosphere_boundary_layer - long_name = vertical index at top atmospheric boundary layer - units = index - dimensions = (horizontal_loop_extent) - type = integer -[kt] - standard_name = vertical_index_difference_between_layer_and_upper_bound - long_name = vertical index difference between layer and upper bound - units = index - dimensions = () - type = integer -[ktop] - standard_name = vertical_index_at_cloud_top - long_name = vertical index at cloud top - units = index - dimensions = (horizontal_loop_extent) - type = integer -[latidxprnt] - standard_name = latitude_index_in_debug_printouts - long_name = latitude index in debug printouts - units = index - dimensions = () - type = integer -[levi] - standard_name = vertical_interface_dimension - long_name = vertical interface dimension - units = count - dimensions = () - type = integer -[lmk] - standard_name = adjusted_vertical_layer_dimension_for_radiation - long_name = adjusted number of vertical layers for radiation - units = count - dimensions = () - type = integer -[lmp] - standard_name = adjusted_vertical_level_dimension_for_radiation - long_name = adjusted number of vertical levels for radiation - units = count - dimensions = () - type = integer -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_loop_extent,3) - type = integer -[mg3_as_mg2] - standard_name = flag_mg3_as_mg2 - long_name = flag for controlling prep for Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_loop_extent,3) - type = integer -[nbdlw] - standard_name = number_of_aerosol_bands_for_longwave_radiation - long_name = number of aerosol bands for longwave radiation - units = count - dimensions = () - type = integer -[nbdsw] - standard_name = number_of_aerosol_bands_for_shortwave_radiation - long_name = number of aerosol bands for shortwave radiation - units = count - dimensions = () - type = integer -[ncgl] - standard_name = local_graupel_number_concentration - long_name = number concentration of graupel local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[ncpi] - standard_name = local_ice_number_concentration - long_name = number concentration of ice local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_shoc) -[ncpl] - standard_name = local_condesed_water_number_concentration - long_name = number concentration of condensed water local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_shoc) -[ncpr] - standard_name = local_rain_number_concentration - long_name = number concentration of rain local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[ncps] - standard_name = local_snow_number_concentration - long_name = number concentration of snow local to physics - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[ncstrac] - standard_name = number_of_tracers_for_CS - long_name = number of convectively transported tracers in Chikira-Sugiyama deep convection scheme - units = count - dimensions = () - type = integer -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer -[nf_aelw] - standard_name = number_of_aerosol_output_fields_for_longwave_radiation - long_name = number of aerosol output fields for longwave radiation - units = count - dimensions = () - type = integer -[nf_aesw] - standard_name = number_of_aerosol_output_fields_for_shortwave_radiation - long_name = number of aerosol output fields for shortwave radiation - units = count - dimensions = () - type = integer -[nn] - standard_name = number_of_tracers_for_convective_transport - long_name = number of tracers for convective transport - units = count - dimensions = () - type = integer -[nsamftrac] - standard_name = number_of_tracers_for_samf - long_name = number of tracers for scale-aware mass flux schemes - units = count - dimensions = () - type = integer -[nscav] - standard_name = number_of_tracers_scavenged - long_name = number of tracers scavenged - units = count - dimensions = () - type = integer -[nspc1] - standard_name = number_of_species_for_aerosol_optical_depth - long_name = number of species for output aerosol optical depth plus total - units = count - dimensions = () - type = integer -[ntiwx] - standard_name = index_for_ice_cloud_condensate_vertical_diffusion_tracer - long_name = index for ice cloud condensate in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[ntk] - standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer - long_name = index for turbulent kinetic energy in the convectively transported tracer array - units = index - dimensions = () - type = integer -[ntkev] - standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer - long_name = index for turbulent kinetic energy in the vertically diffused tracer array - units = index - dimensions = () - type = integer -[nvdiff] - standard_name = number_of_vertical_diffusion_tracers - long_name = number of tracers to diffuse vertically - units = count - dimensions = () - type = integer -[oa4] - standard_name = asymmetry_of_subgrid_orography - long_name = asymmetry of subgrid orography - units = none - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys -[varss] - standard_name = standard_deviation_of_subgrid_orography_small_scale - long_name = standard deviation of subgrid orography small scale - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (gwd_opt == 3 .or. gwd_opt == 33) -[oa4ss] - standard_name = asymmetry_of_subgrid_orography_small_scale - long_name = asymmetry of subgrid orography small scale - units = none - dimensions = (horizontal_loop_extent,4) - type = real - kind = kind_phys - active = (gwd_opt == 3 .or. gwd_opt == 33) -[oc] - standard_name = convexity_of_subgrid_orography - long_name = convexity of subgrid orography - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ocss] - standard_name = convexity_of_subgrid_orography_small_scale - long_name = convexity of subgrid orography small scale - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (gwd_opt == 3 .or. gwd_opt == 33) -[olyr] - standard_name = ozone_concentration_at_layer_for_radiation - long_name = ozone concentration layer - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[otspt] - standard_name = flag_convective_tracer_transport - long_name = flag to enable tracer transport by updrafts/downdrafts[(:,1)] or subsidence [(:,2)] - units = flag - dimensions = (number_of_tracers_plus_one,2) - type = logical -[oz_coeffp5] - standard_name = number_of_coefficients_in_ozone_forcing_data_plus_five - long_name = number of coefficients in ozone forcing data plus five - units = index - dimensions = () - type = integer -[phys_hydrostatic] - standard_name = flag_for_hydrostatic_heating_from_physics - long_name = flag for use of hydrostatic heating in physics - units = flag - dimensions = () - type = logical -[plvl] - standard_name = air_pressure_at_interface_for_radiation_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) - type = real - kind = kind_phys -[plyr] - standard_name = air_pressure_at_layer_for_radiation_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[prnum] - standard_name = prandtl_number - long_name = turbulent Prandtl number - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[q2mp] - standard_name = specific_humidity_at_2m_from_noahmp - long_name = 2 meter specific humidity from noahmp - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[qgl] - standard_name = local_graupel_mixing_ratio - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[qicn] - standard_name = mass_fraction_of_convective_cloud_ice - long_name = mass fraction of convective cloud ice water - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[qlcn] - standard_name = mass_fraction_of_convective_cloud_liquid_water - long_name = mass fraction of convective cloud liquid water - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[qlyr] - standard_name = water_vapor_specific_humidity_at_layer_for_radiation - long_name = specific humidity layer - units = kg kg-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[qrn] - standard_name = local_rain_water_mixing_ratio - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[qsnw] - standard_name = local_snow_water_mixing_ratio - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme .or. flag_for_shoc) -[prcpmp] - standard_name = lwe_thickness_of_explicit_precipitation_amount - long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_water] - standard_name = surface_specific_humidity_over_water - long_name = surface air saturation specific humidity over water - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_land] - standard_name = surface_specific_humidity_over_land - long_name = surface air saturation specific humidity over land - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qss_ice] - standard_name = surface_specific_humidity_over_ice - long_name = surface air saturation specific humidity over ice - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[qs1] - standard_name = saturation_specific_humidity_at_lowest_model_layer - long_name = saturation specific humidity at lowest model layer - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[qv1] - standard_name = bounded_specific_humidity_at_lowest_model_layer_over_land - long_name = specific humidity at lowest model layer over land bounded between a nonzero epsilon and saturation - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[radar_reset] - standard_name = flag_for_resetting_radar_reflectivity_calculation - long_name = flag for resetting radar reflectivity calculation - units = flag - dimensions = () - type = logical -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s - dimensions = () - type = real - kind = kind_phys -[raincd] - standard_name = lwe_thickness_of_deep_convective_precipitation_amount - long_name = deep convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[raincs] - standard_name = lwe_thickness_of_shallow_convective_precipitation_amount - long_name = shallow convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rainmcadj] - standard_name = lwe_thickness_of_moist_convective_adj_precipitation_amount - long_name = adjusted moist convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rainmp] - standard_name = lwe_thickness_of_explicit_rain_amount - long_name = explicit rain on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_gfdl_microphysics_scheme .or. flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme) -[rainp] - standard_name = tendency_of_rain_water_mixing_ratio_due_to_microphysics - long_name = tendency of rain water mixing ratio due to microphysics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[rb] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_water] - standard_name = bulk_richardson_number_at_lowest_model_level_over_water - long_name = bulk Richardson number at the surface over water - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_land] - standard_name = bulk_richardson_number_at_lowest_model_level_over_land - long_name = bulk Richardson number at the surface over land - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[rb_ice] - standard_name = bulk_richardson_number_at_lowest_model_level_over_ice - long_name = bulk Richardson number at the surface over ice - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[reset] - standard_name = flag_reset_maximum_hourly_fields - long_name = flag for resetting maximum hourly fields - units = flag - dimensions = () - type = logical -[rhc] - standard_name = critical_relative_humidity - long_name = critical relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[rho1] - standard_name = air_density_at_lowest_model_layer - long_name = air density at lowest model layer - units = kg m-3 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[runoff] - standard_name = surface_runoff_flux - long_name = surface runoff flux - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[runoff_in_m_sm1] - standard_name = surface_runoff_flux_in_m_sm1 - long_name = surface runoff flux in m s-1 - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[save_q(:,:,index_for_ozone)] - standard_name = ozone_mixing_ratio_save - long_name = ozone mixing ratio before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_for_liquid_cloud_condensate)] - standard_name = cloud_condensed_water_mixing_ratio_save - 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_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_for_ice_cloud_condensate)] - standard_name = ice_water_mixing_ratio_save - long_name = cloud ice water mixing ratio before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_q(:,:,index_for_water_vapor)] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_q] - standard_name = tracer_concentration_save - long_name = tracer concentration before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys -[save_t] - standard_name = air_temperature_save - long_name = air temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_tcp] - standard_name = air_temperature_save_from_convective_parameterization - long_name = air temperature after cumulus parameterization - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_u] - standard_name = x_wind_save - long_name = x-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[save_v] - standard_name = y_wind_save - long_name = y-wind before entering a physics scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[sbsno] - standard_name = snow_deposition_sublimation_upward_latent_heat_flux - long_name = latent heat flux from snow depo/subl - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type -[sfcalb] - standard_name = surface_albedo_components - long_name = surface albedo IR/UV/VIS components - units = frac - dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) - type = real - kind = kind_phys -[sfcalb(:,1)] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,2)] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,3)] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sfcalb(:,4)] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigma] - standard_name = slope_of_subgrid_orography - long_name = slope of subgrid orography - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigmaf] - standard_name = bounded_vegetation_area_fraction - long_name = areal fractional cover of green vegetation bounded on the bottom - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[sigmafrac] - standard_name = convective_updraft_area_fraction - long_name = convective updraft area fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[sigmatot] - standard_name = convective_updraft_area_fraction_at_model_interfaces - long_name = convective updraft area fraction at model interfaces - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[skip_macro] - standard_name = flag_skip_macro - long_name = flag to skip cloud macrophysics in Morrison scheme - units = flag - dimensions = () - type = logical -[slc_save] - standard_name = volume_fraction_of_unfrozen_soil_moisture_save - long_name = liquid soil moisture before entering a physics scheme - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[slopetype] - standard_name = surface_slope_classification - long_name = surface slope type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer -[smcmax] - standard_name = soil_porosity - long_name = volumetric soil porosity - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[smc_save] - standard_name = volume_fraction_of_soil_moisture_save - long_name = total soil moisture before entering a physics scheme - units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snowc] - standard_name = surface_snow_area_fraction - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snowd_ice] - standard_name = surface_snow_thickness_water_equivalent_over_ice - long_name = water equivalent snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snowd_land_save] - standard_name = surface_snow_thickness_water_equivalent_over_land_save - long_name = water equivalent snow depth over land before entering a physics scheme - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snow_depth] - standard_name = actual_snow_depth - long_name = actual snow depth - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snohf] - standard_name = snow_freezing_rain_upward_latent_heat_flux - long_name = latent heat flux due to snow and frz rain - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[snohf_snow] - standard_name = latent_heat_flux_from_precipitating_snow - long_name = latent heat flux due to precipitating snow - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snohf_frzgra] - standard_name = latent_heat_flux_from_freezing_rain - long_name = latent heat flux due to freezing rain - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snohf_snowmelt] - standard_name = latent_heat_flux_due_to_snowmelt - long_name = latent heat flux due to snowmelt phase change - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[snowmp] - standard_name = lwe_thickness_of_snow_amount - long_name = explicit snow fall on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_gfdl_microphysics_scheme .or. flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme) -[snowmt] - standard_name = surface_snow_melt - long_name = snow melt during timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[soilm_in_m] - standard_name = soil_moisture_content_in_m - long_name = soil moisture in meters - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[soiltype] - standard_name = soil_type_classification - long_name = soil type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer -[stc_save] - standard_name = soil_temperature_save - long_name = soil temperature before entering a physics scheme - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[stress] - standard_name = surface_wind_stress - long_name = surface wind stress - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_water] - standard_name = surface_wind_stress_over_water - long_name = surface wind stress over water - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_land] - standard_name = surface_wind_stress_over_land - long_name = surface wind stress over land - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[stress_ice] - standard_name = surface_wind_stress_over_ice - long_name = surface wind stress over ice - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[t2mmp] - standard_name = temperature_at_2m_from_noahmp - long_name = 2 meter temperature from noahmp - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme) -[theta] - standard_name = angle_from_east_of_maximum_subgrid_orographic_variations - long_name = angle with_respect to east of maximum subgrid orographic variations - units = degree - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[th1] - standard_name = potential_temperature_at_lowest_model_layer - long_name = potential_temperature_at_lowest_model_layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[tice] - standard_name = sea_ice_temperature_interstitial - long_name = sea ice surface skin temperature use as interstitial - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tlvl] - standard_name = air_temperature_at_interface_for_radiation - long_name = air temperature at vertical interface for radiation calculation - units = K - dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) - type = real - kind = kind_phys -[tlyr] - standard_name = air_temperature_at_layer_for_radiation - long_name = air temperature at vertical layer for radiation calculation - units = K - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys -[tprcp_water] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water - long_name = total precipitation amount in each time step over water - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp_land] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land - long_name = total precipitation amount in each time step over land - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp_ice] - standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice - long_name = total precipitation amount in each time step over ice - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tprcp_rate_land] - standard_name = total_precipitation_rate_on_dynamics_timestep_over_land - long_name = total precipitation rate in each time step over land - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[tracers_start_index] - standard_name = start_index_of_other_tracers - long_name = beginning index of the non-water tracer species - units = index - dimensions = () - type = integer -[tracers_total] - standard_name = number_of_total_tracers - long_name = total number of tracers - units = count - dimensions = () - type = integer -[trans_aero] - standard_name = flag_for_aerosol_convective_transport_and_PBL_diffusion - long_name = flag for aerosol convective transport and PBL diffusion - units = flag - dimensions = () - type = logical -[trans] - standard_name = transpiration_flux - long_name = total plant transpiration rate - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tseal] - standard_name = surface_skin_temperature_for_nsst - long_name = ocean surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfc_water] - standard_name = surface_skin_temperature_over_water_interstitial - long_name = surface skin temperature over water (temporary use as interstitial) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfc_land] - standard_name = surface_skin_temperature_over_land_interstitial - long_name = surface skin temperature over land (temporary use as interstitial) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfc_land_save] - standard_name = surface_skin_temperature_over_land_interstitial_save - long_name = surface skin temperature over land before entering a physics scheme (temporary use as interstitial) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[tsfc_ice] - standard_name = surface_skin_temperature_over_ice_interstitial - long_name = surface skin temperature over ice (temporary use as interstitial) - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_water] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_land] - standard_name = surface_skin_temperature_after_iteration_over_land - long_name = surface skin temperature after iteration over land - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tsurf_ice] - standard_name = surface_skin_temperature_after_iteration_over_ice - long_name = surface skin temperature after iteration over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tracers_water] - standard_name = number_of_water_tracers - long_name = number of water-related tracers - units = count - dimensions = () - type = integer -[ud_mf] - standard_name = instantaneous_atmosphere_updraft_convective_mass_flux - long_name = (updraft mass flux) * delt - units = kg m-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[uustar_water] - standard_name = surface_friction_velocity_over_water - long_name = surface friction velocity over water - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uustar_land] - standard_name = surface_friction_velocity_over_land - long_name = surface friction velocity over land - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[uustar_ice] - standard_name = surface_friction_velocity_over_ice - long_name = surface friction velocity over ice - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vdftra] - standard_name = vertically_diffused_tracer_concentration - long_name = tracer concentration diffused by PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys -[lndp_vgf] - standard_name = magnitude_of_perturbation_of_vegetation_fraction - long_name = magnitude of perturbation of vegetation fraction - units = frac - dimensions = () - type = real - kind = kind_phys -[vegf1d] - standard_name = perturbation_of_vegetation_fraction - long_name = perturbation of vegetation fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer -[w_upi] - standard_name = vertical_velocity_for_updraft - long_name = vertical velocity for updraft - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_microphysics_scheme == flag_for_morrison_gettelman_microphysics_scheme) -[wcbmax] - standard_name = maximum_updraft_velocity_at_cloud_base - long_name = maximum updraft velocity at cloud base - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[weasd_land] - standard_name = water_equivalent_accumulated_snow_depth_over_land - long_name = water equiv of acc snow depth over land - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[weasd_land_save] - standard_name = water_equivalent_accumulated_snow_depth_over_land_save - long_name = water equiv of acc snow depth over land before entering a physics scheme - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[weasd_ice] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[wind] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work1] - standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes - long_name = grid size related coefficient used in scale-sensitive schemes - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work2] - standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement - long_name = complement to work1 - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[work3] - standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer - long_name = Exner function ratio bt midlayer and interface at 1st layer - units = ratio - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xcosz] - standard_name = instantaneous_cosine_of_zenith_angle - long_name = cosine of zenith angle at current time - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xlai1d] - standard_name = perturbation_of_leaf_area_index - long_name = perturbation of leaf area index - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[z01d] - standard_name = perturbation_of_momentum_roughness_length - long_name = perturbation of momentum roughness length - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_water] - standard_name = bounded_surface_roughness_length_for_heat_over_water - long_name = bounded surface roughness length for heat over water - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_land] - standard_name = bounded_surface_roughness_length_for_heat_over_land - long_name = bounded surface roughness length for heat over land - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[ztmax_ice] - standard_name = bounded_surface_roughness_length_for_heat_over_ice - long_name = bounded surface roughness length for heat over ice - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zt1d] - standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio - long_name = perturbation of heat to momentum roughness length ratio - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dudt_ngw] - standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag - long_name = zonal wind tendency due to non-stationary GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dvdt_ngw] - standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag - long_name = meridional wind tendency due to non-stationary GWs - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[dtdt_ngw] - standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag - long_name = air temperature tendency due to non-stationary GWs - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[kdis_ngw] - standard_name = atmosphere_momentum_diffusivity_due_to_nonorographic_gravity_wave_drag - long_name = eddy mixing due to non-stationary GWs - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_ugwp_version_1 .or. gwd_opt==33 .or. gwd_opt==22 .or. gwd_opt==3 .or. gwd_opt==2) -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[zngw] - standard_name = height_of_launch_level_of_nonorographic_gravity_waves - long_name = height of launch level of non-stationary GWs - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_tofd] - standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag - long_name = instantaneous momentum flux due to TOFD - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_mtb] - standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag - long_name = instantaneous momentum flux due to mountain blocking drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ogw] - standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag - long_name = instantaneous momentum flux due to orographic gravity wave drag - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_oss] - standard_name = momentum_flux_due_to_subgrid_scale_orographic_gravity_wave_drag - long_name = momentum flux or stress due to SSO including OBL-OSS-OFD - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[tau_ngw] - standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave - long_name = instantaneous momentum flux due to nonstationary gravity waves - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[dudt_mtb] - standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag - long_name = instantaneous change in x wind due to mountain blocking drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[dudt_tms] - standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag - long_name = instantaneous change in x wind due to TOFD - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[qs_lay] - standard_name = saturation_vapor_pressure - long_name = saturation vapor pressure - units = Pa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - optional = F - active = (flag_for_rrtmgp_radiation_scheme) -[q_lay] - standard_name = water_vapor_mixing_ratio - long_name = water vaport mixing ratio - units = kg/kg - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - optional = F - active = (flag_for_rrtmgp_radiation_scheme) -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure layer - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa - long_name = air pressure level - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[deltaZ] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter for RRTMGP (but not for RRTMG) - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[ipsdsw0] - standard_name = initial_permutation_seed_sw - long_name = initial seed for McICA SW - units = none - dimensions = () - type = integer -[ipsdlw0] - standard_name = initial_permutation_seed_lw - long_name = initial seed for McICA LW - units = none - dimensions = () - type = integer -[cldtausw] - standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[cldtaulw] - standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys -[fluxlwUP_clrsky] - standard_name = RRTMGP_lw_flux_profile_upward_clrsky - long_name = RRTMGP upward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxlwDOWN_clrsky] - standard_name = RRTMGP_lw_flux_profile_downward_clrsky - long_name = RRTMGP downward longwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswUP_allsky] - standard_name = RRTMGP_sw_flux_profile_upward_allsky - long_name = RRTMGP upward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswDOWN_allsky] - standard_name = RRTMGP_sw_flux_profile_downward_allsky - long_name = RRTMGP downward shortwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswUP_clrsky] - standard_name = RRTMGP_sw_flux_profile_upward_clrsky - long_name = RRTMGP upward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[fluxswDOWN_clrsky] - standard_name = RRTMGP_sw_flux_profile_downward_clrsky - long_name = RRTMGP downward shortwave clr-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[flxprf_lw] - standard_name = RRTMGP_lw_fluxes - long_name = lw fluxes total sky / csk and up / down at levels - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = proflw_type - active = (flag_for_rrtmgp_radiation_scheme) -[flxprf_sw] - standard_name = RRTMGP_sw_fluxes - long_name = sw fluxes total sky / csk and up / down at levels - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = profsw_type - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolslw] - standard_name = RRTMGP_aerosol_optical_properties_for_longwave_bands_01_16 - long_name = aerosol optical properties for longwave bands 01-16 - units = various - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_lw_bands_rrtmgp,number_of_aerosol_output_fields_for_longwave_radiation) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolslw(:,:,:,1)] - standard_name = RRTMGP_aerosol_optical_depth_for_longwave_bands_01_16 - long_name = aerosol optical depth for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_lw_bands_rrtmgp) - type = real - kind = kind_phys -[aerosolslw(:,:,:,2)] - standard_name = RRTMGP_aerosol_single_scattering_albedo_for_longwave_bands_01_16 - long_name = aerosol single scattering albedo for longwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_lw_bands_rrtmgp) - type = real - kind = kind_phys -[aerosolslw(:,:,:,3)] - standard_name = RRTMGP_aerosol_asymmetry_parameter_for_longwave_bands_01_16 - long_name = aerosol asymmetry parameter for longwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_lw_bands_rrtmgp) - type = real - kind = kind_phys -[aerosolssw] - standard_name = RRTMGP_aerosol_optical_properties_for_shortwave_bands_01_16 - long_name = aerosol optical properties for shortwave bands 01-16 - units = various - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_sw_bands_rrtmgp, number_of_aerosol_output_fields_for_shortwave_radiation) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[aerosolssw(:,:,:,1)] - standard_name = RRTMGP_aerosol_optical_depth_for_shortwave_bands_01_16 - long_name = aerosol optical depth for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_sw_bands_rrtmgp) - type = real - kind = kind_phys -[aerosolssw(:,:,:,2)] - standard_name = RRTMGP_aerosol_single_scattering_albedo_for_shortwave_bands_01_16 - long_name = aerosol single scattering albedo for shortwave bands 01-16 - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_sw_bands_rrtmgp) - type = real - kind = kind_phys -[aerosolssw(:,:,:,3)] - standard_name = RRTMGP_aerosol_asymmetry_parameter_for_shortwave_bands_01_16 - long_name = aerosol asymmetry parameter for shortwave bands 01-16 - units = none - dimensions = (horizontal_loop_extent,vertical_dimension, number_of_sw_bands_rrtmgp) - type = real - kind = kind_phys -[icseed_lw] - standard_name = seed_random_numbers_lw_for_RRTMGP - long_name = seed for random number generation for longwave radiation - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_rrtmgp_radiation_scheme) -[icseed_sw] - standard_name = seed_random_numbers_sw_for_RRTMGP - long_name = seed for random number generation for shortwave radiation - units = none - dimensions = (horizontal_loop_extent) - type = integer - active = (flag_for_rrtmgp_radiation_scheme) -[precip_frac] - standard_name = precipitation_fraction_by_layer - long_name = precipitation fraction in each layer - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_clrsky] - standard_name = shortwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_cloudsByBand] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_precipByBand] - standard_name = shortwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_precip] - standard_name = shortwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_clouds] - standard_name = shortwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[sw_optical_props_aerosol] - standard_name = shortwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[gas_concentrations] - standard_name = Gas_concentrations_for_RRTMGP_suite - long_name = DDT containing gas concentrations for RRTMGP radiation scheme - units = DDT - dimensions = () - type = ty_gas_concs - active = (flag_for_rrtmgp_radiation_scheme) -[sources] - standard_name = longwave_source_function - long_name = Fortran DDT containing RRTMGP source functions - units = DDT - dimensions = () - type = ty_source_func_lw - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_clrsky] - standard_name = longwave_optical_properties_for_clear_sky - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_clouds] - standard_name = longwave_optical_properties_for_cloudy_atmosphere - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_precip] - standard_name = longwave_optical_properties_for_precipitation - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_cloudsByBand] - standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_precipByBand] - standard_name = longwave_optical_properties_for_precipitation_by_band - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_2str - active = (flag_for_rrtmgp_radiation_scheme) -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_emiss_byband] - standard_name = surface_emissivity_in_each_RRTMGP_LW_band - long_name = surface emissivity in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sec_diff_byband] - standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band - long_name = secant of diffusivity angle in each RRTMGP LW band - units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_nir_dir] - standard_name = surface_albedo_nearIR_direct - long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) - units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_nir_dif] - standard_name = surface_albedo_nearIR_diffuse - long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) - units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir - long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) - units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif - long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) - units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[toa_src_lw] - standard_name = toa_incident_lw_flux_by_spectral_point - long_name = TOA longwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_lw_spectral_points_rrtmgp) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[toa_src_sw] - standard_name = toa_incident_sw_flux_by_spectral_point - long_name = TOA shortwave incident flux at each spectral points - units = W m-2 - dimensions = (horizontal_loop_extent,number_of_sw_spectral_points_rrtmgp) - type = real - kind = kind_phys - active = (flag_for_rrtmgp_radiation_scheme) -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=128 - active = (flag_for_rrtmgp_radiation_scheme) - -######################################################################## -[ccpp-table-properties] - name = GFS_data_type - type = ddt - dependencies = - -[ccpp-arg-table] - name = GFS_data_type - type = ddt -[Statein] - standard_name = GFS_statein_type_instance - long_name = prognostic state data in from dycore - units = DDT - dimensions = () - type = GFS_statein_type -[Stateout] - standard_name = GFS_stateout_type_instance - long_name = prognostic state or tendencies return to dycore - units = DDT - dimensions = () - type = GFS_stateout_type -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = surface fields - units = DDT - dimensions = () - type = GFS_sfcprop_type -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = fields to/from coupling with other components (land/ice/ocean) - units = DDT - dimensions = () - type = GFS_coupling_type -[Grid] - standard_name = GFS_grid_type_instance - long_name = grid and interpolation related data - units = DDT - dimensions = () - type = GFS_grid_type -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = to be determined data that doesn't fit in any one container - units = DDT - dimensions = () - type = GFS_tbd_type -[Cldprop] - standard_name = GFS_cldprop_type_instance - long_name = cloud fields needed by radiation from physics - units = DDT - dimensions = () - type = GFS_cldprop_type -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = radiation tendencies needed in physics - units = DDT - dimensions = () - type = GFS_radtend_type -[Intdiag] - standard_name = GFS_diag_type_instance - long_name = fields targeted for diagnostic output - units = DDT - dimensions = () - type = GFS_diag_type - -######################################################################## -[ccpp-table-properties] - name = GFS_typedefs - type = module - relative_path = ../physics/physics - dependencies = machine.F,physcons.F90,radlw_param.f,radsw_param.f,GFDL_parse_tracers.F90 - dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/rte/mo_optical_props.F90,rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - dependencies = rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_rte_config.F90,rte-rrtmgp/rte/mo_source_functions.F90 - -[ccpp-arg-table] - name = GFS_typedefs - type = module -[GFS_cldprop_type] - standard_name = GFS_cldprop_type - long_name = definition of type GFS_cldprop_type - units = DDT - dimensions = () - type = GFS_cldprop_type -[GFS_control_type] - standard_name = GFS_control_type - long_name = definition of type GFS_control_type - units = DDT - dimensions = () - type = GFS_control_type -[GFS_coupling_type] - standard_name = GFS_coupling_type - long_name = definition of type GFS_coupling_type - units = DDT - dimensions = () - type = GFS_coupling_type -[GFS_data_type] - standard_name = GFS_data_type - long_name = definition of type GFS_data_type - units = DDT - dimensions = () - type = GFS_data_type -[GFS_diag_type] - standard_name = GFS_diag_type - long_name = definition of type GFS_diag_type - units = DDT - dimensions = () - type = GFS_diag_type -[GFS_grid_type] - standard_name = GFS_grid_type - long_name = definition of type GFS_grid_type - units = DDT - dimensions = () - type = GFS_grid_type -[GFS_interstitial_type] - standard_name = GFS_interstitial_type - long_name = definition of type GFS_interstitial_type - units = DDT - dimensions = () - type = GFS_interstitial_type -[GFS_radtend_type] - standard_name = GFS_radtend_type - long_name = definition of type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type -[GFS_sfcprop_type] - standard_name = GFS_sfcprop_type - long_name = definition of type GFS_sfcprop_type - units = DDT - dimensions = () - type = GFS_sfcprop_type -[GFS_statein_type] - standard_name = GFS_statein_type - long_name = definition of type GFS_statein_type - units = DDT - dimensions = () - type = GFS_statein_type -[GFS_stateout_type] - standard_name = GFS_stateout_type - long_name = definition of type GFS_stateout_type - units = DDT - dimensions = () - type = GFS_stateout_type -[GFS_tbd_type] - standard_name = GFS_tbd_type - long_name = definition of type GFS_tbd_type - units = DDT - dimensions = () - type = GFS_tbd_type -[LTP] - standard_name = extra_top_layer - long_name = extra top layer for radiation - units = none - dimensions = () - type = integer -[huge] - standard_name = netcdf_float_fillvalue - long_name = definition of NetCDF float FillValue - units = none - dimensions = () - type = real - kind = kind_phys -[con_cliq] - standard_name = specific_heat_of_liquid_water_at_constant_pressure - long_name = specific heat of liquid water at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys -[con_cvap] - standard_name = specific_heat_of_water_vapor_at_constant_pressure - long_name = specific heat of water vapor at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys -[con_eps] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants - long_name = rd/rv - units = none - dimensions = () - type = real - kind = kind_phys -[con_epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys -[con_epsqs] - standard_name = minimum_value_of_saturation_mixing_ratio - long_name = floor value for saturation mixing ratio - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys -[con_omega] - standard_name = angular_velocity_of_earth - long_name = angular velocity of earth - units = s-1 - dimensions = () - type = real - kind = kind_phys -[con_rerth] - standard_name = radius_of_earth - long_name = radius of earth - units = m - dimensions = () - type = real - kind = kind_phys -[con_epsm1] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one - long_name = (rd/rv) - 1 - units = none - dimensions = () - type = real - kind = kind_phys -[con_rocp] - standard_name = ratio_of_gas_constant_dry_air_to_specific_heat_of_dry_air_at_constant_pressure - long_name = (rd/cp) - units = none - dimensions = () - type = real - kind = kind_phys -[con_rog] - standard_name = ratio_of_gas_constant_dry_air_to_gravitational_acceleration - long_name = (rd/g) - units = J s2 K-1 kg-1 m-1 - dimensions = () - type = real - kind = kind_phys -[con_fvirt] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys -[con_hvap] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of evaporation/sublimation - units = J kg-1 - dimensions = () - type = real - kind = kind_phys -[con_hfus] - standard_name = latent_heat_of_fusion_of_water_at_0C - long_name = latent heat of fusion - units = J kg-1 - dimensions = () - type = real - kind = kind_phys -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys -[con_rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys -[con_rv] - standard_name = gas_constant_water_vapor - long_name = ideal gas constant for water vapor - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys -[con_t0c] - standard_name = temperature_at_zero_celsius - long_name = temperature at 0 degree Celsius - units = K - dimensions = () - type = real - kind = kind_phys -[con_ttp] - standard_name = triple_point_temperature_of_water - long_name = triple point temperature of water - units = K - dimensions = () - type = real - kind = kind_phys -[cimin] - standard_name = minimum_sea_ice_concentration - long_name = minimum sea ice concentration - units = frac - dimensions = () - type = real - kind = kind_phys -[rlapse] - standard_name = air_temperature_lapse_rate_constant - long_name = environmental air temperature lapse rate constant - units = K m-1 - dimensions = () - type = real - kind = kind_phys -[con_jcal] - standard_name = joules_per_calorie_constant - long_name = joules per calorie constant - units = J cal-1 - dimensions = () - type = real - kind = kind_phys -[con_rhw0] - standard_name = sea_water_reference_density - long_name = sea water reference density - units = kg m-3 - dimensions = () - type = real - kind = kind_phys -[con_sbc] - standard_name = stefan_boltzmann_constant - long_name = Stefan-Boltzmann constant - units = W m-2 K-4 - dimensions = () - type = real - kind = kind_phys -[con_tice] - standard_name = freezing_point_temperature_of_seawater - long_name = freezing point temperature of seawater - units = K - dimensions = () - type = real - kind = kind_phys -[con_p0] - standard_name = standard_atmospheric_pressure - long_name = standard atmospheric pressure - units = Pa - dimensions = () - type = real - kind = kind_phys -[rhowater] - standard_name = liquid_water_density - long_name = density of liquid water - units = kg m-3 - 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 From 8fe65eef7a059be782626d843d5d6a0e679ab491 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Jun 2021 13:38:16 +0000 Subject: [PATCH 158/217] after submodule sync --- ccpp/framework | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/framework b/ccpp/framework index 54b158f91..075e08e28 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 54b158f91fb0abf58ab099d4ae80a57d7f1ee0b8 +Subproject commit 075e08e2887d1dbd4fe95003689eac69aca5f32c From e4e0e40ab531e1edeed4ebfd360fb8a91e42f3e3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Jun 2021 17:26:01 +0000 Subject: [PATCH 159/217] removing extra post files --- io/post_gfs.F90_mine | 2511 ------------------------------------------ io/post_gfs.F90_v16 | 2473 ----------------------------------------- 2 files changed, 4984 deletions(-) delete mode 100644 io/post_gfs.F90_mine delete mode 100644 io/post_gfs.F90_v16 diff --git a/io/post_gfs.F90_mine b/io/post_gfs.F90_mine deleted file mode 100644 index 248ce6d06..000000000 --- a/io/post_gfs.F90_mine +++ /dev/null @@ -1,2511 +0,0 @@ -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! -module post_gfs - - use module_fv3_io_def, only : wrttasks_per_group,filename_base - use write_internal_state, only : wrt_internal_state - - implicit none - - include 'mpif.h' - - integer mype, nbdl - logical setvar_atmfile, setvar_sfcfile, read_postcntrl - public post_run_gfs, post_getattr_gfs - - contains - - subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & - mynfhr,mynfmin,mynfsec) -! -! revision history: -! Jul 2019 J. Wang create interface to run inline post for FV3 -! -!----------------------------------------------------------------------- -!*** run post on write grid comp -!----------------------------------------------------------------------- -! - use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & - npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat - use gridspec_mod, only : maptype, gridtype - use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl - use xml_perl_data,only : paramset -! -!----------------------------------------------------------------------- -! - implicit none -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mypei - integer,intent(in) :: mpicomp - integer,intent(in) :: lead_write - integer,intent(in) :: mynfhr - integer,intent(in) :: mynfmin - integer,intent(in) :: mynfsec -! -!----------------------------------------------------------------------- -!*** LOCAL VARIABLES -!----------------------------------------------------------------------- -! - integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil - integer,allocatable :: jstagrp(:),jendgrp(:) - integer,save :: kpo,kth,kpv - logical,save :: log_postalct=.false. - real,dimension(komax),save :: po, th, pv - logical :: Log_runpost - character(255) :: post_fname*255 - - integer,save :: iostatusD3D=-1 -! - real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 -! -! print *,'in post_run start' -!----------------------------------------------------------------------- -!*** set up dimensions -!----------------------------------------------------------------------- -! - btim0 = MPI_Wtime() - - modelname = "GFS" - grib = "grib2" - gridtype = "A" - nsoil = 4 - mype = mypei - nwtpg = wrt_int_state%petcount - jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection - jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection - maptype = wrt_int_state%post_maptype - nbdl = wrt_int_state%FBCount - - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & - 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct - -! -!----------------------------------------------------------------------- -!*** set up fields to run post -!----------------------------------------------------------------------- -! - if (.not.log_postalct) then -! - allocate(jstagrp(nwtpg),jendgrp(nwtpg)) -! - do n=0,nwtpg-1 - jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) - jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) - enddo - if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp - -!----------------------------------------------------------------------- -!*** read namelist for pv,th,po -!----------------------------------------------------------------------- -! - call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_nlunit, & - wrt_int_state%post_namelist) -! -!----------------------------------------------------------------------- -!*** allocate post variables -!----------------------------------------------------------------------- -! -! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & -! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) -! -!----------------------------------------------------------------------- -!*** read namelist for pv,th,po -!----------------------------------------------------------------------- -! - log_postalct = .true. - first_grbtbl = .true. - read_postcntrl = .true. -! - ENDIF -! -!----------------------------------------------------------------------- -!*** fill post variables with values from forecast results -!----------------------------------------------------------------------- -! - ifhr = mynfhr - ifmin = mynfmin - if (ifhr == 0 ) ifmin = 0 - if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. - call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) - -! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & -! 'setvar_sfcfile=',setvar_sfcfile -! - if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics -! call MICROINIT -! - if(grib=="grib2" .and. read_postcntrl) then - if (ifhr == 0) then - filenameflat = 'postxconfig-NT_FH00.txt' - call read_xml() - if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat) - else if(ifhr > 0) then - filenameflat = 'postxconfig-NT.txt' - if(size(paramset)>0) then - do i=1,size(paramset) - if (size(paramset(i)%param)>0) then - deallocate(paramset(i)%param) - nullify(paramset(i)%param) - endif - enddo - deallocate(paramset) - nullify(paramset) - endif - num_pset = 0 - call read_xml() - if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr - read_postcntrl = .false. - endif - endif -! - IEOF = 0 - npset = 0 - icount_calmict = 0 - do while( IEOF == 0) -! - if(grib == "grib2") then - npset = npset + 1 - call set_outflds(kth,th,kpv,pv) - if(allocated(datapd))deallocate(datapd) - allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) - do k=1,nrecout+100 - do j=1,jend+1-jsta - do i=1,im - datapd(i,j,k) = 0. - enddo - enddo - enddo - call get_postfilename(post_fname) - if (mype==0) write(0,*)'post_fname=',trim(post_fname) -! - if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) -! - call mpi_barrier(mpicomp,ierr) - call gribit2(post_fname) - if(allocated(datapd))deallocate(datapd) - if(allocated(fld_info))deallocate(fld_info) - if(npset >= num_pset) exit - - endif -! - enddo -! - endif - - end subroutine post_run_gfs -! -!----------------------------------------------------------------------- -! - subroutine post_getattr_gfs(wrt_int_state, fldbundle) -! - use esmf - use ctlblk_mod, only: im, jm, mpi_comm_comp - use masks, only: gdlat, gdlon, dx, dy - use gridspec_mod, only: latstart, latlast, lonstart, & - lonlast, cenlon, cenlat -! - implicit none -! - type(wrt_internal_state),intent(inout) :: wrt_int_state - type(ESMF_FieldBundle), intent(in) :: fldbundle -! -! local variable - integer i,j,k,n,kz, attcount - integer ni,naryi,nr4,nr8,rc - integer aklen,varival - real(4) varr4val - real(8) varr8val - character(80) attName, hydrostatics, fldname - type(ESMF_TypeKind_Flag) :: typekind - real(4), dimension(:), allocatable :: ak4,bk4 - real(8), dimension(:), allocatable :: ak8,bk8 -! -! look at the field bundle attributes - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return -! - aklen=0. - do i=1, attCount - - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return - - if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival - endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr4val - endif - else if(n > 1) then - if(trim(attName) =="ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr8val - endif - else if(n > 1) then - if(trim(attName) == "ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - wrt_int_state%lm = size(wrt_int_state%ak) - 1 - endif - endif -! - enddo -! print *,'in post_getattr, dtp=',wrt_int_state%dtp -! - end subroutine post_getattr_gfs -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! - subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) -! -! revision history: -! Jul 2019 J. Wang Initial code -! -!----------------------------------------------------------------------- -!*** set up post fields from nmint_state -!----------------------------------------------------------------------- -! - use esmf - use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & - qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & - q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng - use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& - qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& - cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& - avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, & - cfrach, cfracl, cfracm, avgcfrach, qshltr, & - avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& - vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, & - rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & - rswinc, rswout, aswin, auvbin, auvbinc, aswout, & - aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & - sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & - smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & - acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & - htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & - pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& - maxtshltr, mintshltr, maxrhshltr, minrhshltr, & - dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & - htops, hbots, aswintoa, maxqshltr, minqshltr, & - acond, sr, u10h, v10h, avgedir, avgecan, & - avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& - avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & - alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& - avgpotevp, snoavg, ti, si, cuppt - use soil, only: sldpth, sh2o, smc, stc - use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice - use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & - ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst - use params_mod, only: erad, dtr, capa, p1000 - use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & - qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 - use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & - eps => con_eps, epsm1 => con_epsm1 - use rqstfld_mod -! -! use write_internal_state, only: wrt_internal_state -! -!----------------------------------------------------------------------- -! - implicit none -! - include 'mpif.h' -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mpicomp - logical,intent(inout) :: setvar_atmfile,setvar_sfcfile -! -!----------------------------------------------------------------------- -! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend - integer ista,iend,fieldDimCount,gridDimCount,ncount_field - integer jdate(8) - logical foundland, foundice, found - real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 - real, dimension(:),allocatable :: ak5, bk5 - real(4),dimension(:,:),pointer :: arrayr42d - real(8),dimension(:,:),pointer :: arrayr82d - real(4),dimension(:,:,:),pointer :: arrayr43d - real(8),dimension(:,:,:),pointer :: arrayr83d - real,dimension(:), allocatable :: slat,qstl - real,external::FPVSNEW - real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & - cw2d, cfr2d - character(len=80) :: fieldname, wrtFBName - type(ESMF_Grid) :: wrtGrid - type(ESMF_Field) :: theField - type(ESMF_Field), allocatable :: fcstField(:) - type(ESMF_TypeKind_Flag) :: typekind -! -!----------------------------------------------------------------------- -!*** INTEGER SCALAR/1D HISTORY VARIABLES -!----------------------------------------------------------------------- -! - imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme - dtp = wrt_int_state%dtp - iSF_SURFACE_PHYSICS = 2 - spval = 9.99e20 - -! -! nems gfs has zhour defined - tprec = float(wrt_int_state%fhzero) - tclod = tprec - trdlw = tprec - trdsw = tprec - tsrfc = tprec - tmaxmin = tprec - td3d = tprec - if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & - 'dtp=',dtp,'tmaxmin=',tmaxmin - -! write(6,*) 'maptype and gridtype is ', maptype,gridtype -! -!$omp parallel do default(shared),private(i,j) - do j=jsta,jend - do i=1,im - gdlat(i,j) = wrt_int_state%latPtr(i,j) - gdlon(i,j) = wrt_int_state%lonPtr(i,j) - enddo - enddo -! - lonstart = nint(wrt_int_state%lonstart*gdsdegr) - lonlast = nint(wrt_int_state%lonlast*gdsdegr) - latstart = nint(wrt_int_state%latstart*gdsdegr) - latlast = nint(wrt_int_state%latlast*gdsdegr) -! print*,'latstart,latlast B bcast= ',latstart,latlast -! print*,'lonstart,lonlast B bcast= ',lonstart,lonlast - -!$omp parallel do default(none),private(i,j,ip1), & -!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) - do j = jsta, jend_m - do i = 1, im - ip1 = i + 1 - if (ip1 > im) ip1 = ip1 - im - dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr - dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH - end do - end do -! - if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) - do i=1,lm+1 - ak5(i) = wrt_int_state%ak(i) - bk5(i) = wrt_int_state%bk(i) - enddo - -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) - do j=jsta,jend - do i=1,im - f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) - end do - end do -! -! GFS does not output PD - pt = ak5(1) - -! GFS may not have model derived radar ref. -! TKE -! cloud amount -!$omp parallel do default(none),private(i,j,l), & -!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) - do l=1,lm - do j=jsta,jend - do i=1,im - ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL - cfr(i,j,l) = SPVAL - enddo - enddo - enddo - -! GFS does not have surface specific humidity -! inst sensible heat flux -! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) - do j=jsta,jend - do i=1,im - qs(i,j) = SPVAL - twbs(i,j) = SPVAL - qwbs(i,j) = SPVAL - ths(i,j) = SPVAL - enddo - enddo - -! GFS set up DT to compute accumulated fields, set it to one - dtq2 = wrt_int_state%dtp - nphs = 2. - dt = dtq2/nphs - dtq2001 = dtq2*0.001 -! -! GFS does not have convective cloud efficiency -! similated precip -! 10 m theta -! 10 m humidity -! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) - do j=jsta,jend - do i=1,im - cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL - albase(i,j) = SPVAL - - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? - enddo - enddo - -! GFS probably does not use zenith angle, czen, czmean -! inst surface outgoing longwave, radot -! inst cloud fraction for high, middle, and low cloud, -! cfrach -! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & -!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) - do j=jsta,jend - do i=1,im - czen(i,j) = SPVAL - czmean(i,j) = SPVAL - radot(i,j) = SPVAL - cfrach(i,j) = SPVAL - cfracl(i,j) = SPVAL - cfracm(i,j) = SPVAL - grnflx(i,j) = SPVAL - enddo - enddo -! -! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam - sldpth(1) = 0.10 - sldpth(2) = 0.3 - sldpth(3) = 0.6 - sldpth(4) = 1.0 - -! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n -! cfrcv to 1 -! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 -! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave, rlwin -! inst model top outgoing longwave,rlwtoa -! inst incoming sfc shortwave, rswin -! inst incoming clear sky sfc shortwave, rswinc -! inst outgoing sfc shortwave, rswout -! snow phase change heat flux, snopcx -! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) - do j=jsta,jend - do i=1,im - acfrcv(i,j) = spval - ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval - ncfrst(i,j) = 1.0 - bgroff(i,j) = spval - rlwin(i,j) = spval - rlwtoa(i,j) = spval - rswin(i,j) = spval - rswinc(i,j) = spval - rswout(i,j) = spval - snopcx(i,j) = spval - sfcuvx(i,j) = spval - enddo - enddo - -! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 - ardlw = 1.0 -! GFS incoming sfc longwave has been averaged, set ARDLW to 1 - ardsw = 1.0 -! GFS surface flux has been averaged, set ASRFC to 1 - asrfc = 1.0 - -! GFS does not have temperature tendency due to long wave radiation -! temperature tendency due to short wave radiation -! temperature tendency due to latent heating from convection -! temperature tendency due to latent heating from grid scale - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & -!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) - do j=jsta_2l,jend_2u - do i=1,im - rlwtt(i,j,l) = spval - rswtt(i,j,l) = spval - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval - train(i,j,l) = spval - enddo - enddo - enddo - -! set avrain to 1 - avrain = 1.0 - avcnvc = 1.0 - theat = 6.0 ! just in case GFS decides to output T tendency - -! GFS does not have temperature tendency due to latent heating from grid scale - train = spval - -! GFS does not have soil moisture availability, smstav -! accumulated surface evaporatio, sfcevp -! averaged accumulated snow, acsnow -! snow melt,acsnom -! humidity at roughness length, qz0 -! u at roughness length, uz0 -! v at roughness length, vz0 -! shelter rh max, maxrhshltr -! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) - do j=jsta_2l,jend_2u - do i=1,im - smstav(i,j) = spval - sfcevp(i,j) = spval - acsnow(i,j) = spval - acsnom(i,j) = spval - qz0(i,j) = spval - uz0(i,j) = spval - vz0(i,j) = spval - maxrhshltr(i,j) = SPVAL - minrhshltr(i,j) = SPVAL - enddo - enddo - -! GFS does not have mixing length,el_pbl -! exchange coefficient, exch_h - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) - do j=jsta_2l,jend_2u - do i=1,im - el_pbl(i,j,l) = spval - exch_h(i,j,l) = spval - enddo - enddo - enddo - -! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(htopd,hbotd,htops,hbots,cuppt) - do j=jsta_2l,jend_2u - do i=1,im - htopd(i,j) = SPVAL - hbotd(i,j) = SPVAL - htops(i,j) = SPVAL - hbots(i,j) = SPVAL - cuppt(i,j) = SPVAL - enddo - enddo -! -! get inital date - sdat(1) = wrt_int_state%idate(2) !month - sdat(2) = wrt_int_state%idate(3) !day - sdat(3) = wrt_int_state%idate(1) !year - ihrst = wrt_int_state%idate(4) !hour - - idat(1) = wrt_int_state%fdate(2) - idat(2) = wrt_int_state%fdate(3) - idat(3) = wrt_int_state%fdate(1) - idat(4) = wrt_int_state%fdate(4) - idat(5) = wrt_int_state%fdate(5) -! - if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst -! CALL W3DIFDAT(JDATE,IDATE,0,RINC) -! -! if(mype==0)print *,' rinc=',rinc -! ifhr = nint(rinc(2)+rinc(1)*24.) -! if(mype==0)print *,' ifhr=',ifhr -! ifmin = nint(rinc(3)) -! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop -! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin -! - tstart = 0. -! -!** initialize cloud water and ice mixing ratio -!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & -!$omp& shared(qqw,qqr,qqs,qqi) - do l = 1,lm - do j = jsta, jend - do i = 1,im - qqw(i,j,l) = 0. - qqr(i,j,l) = 0. - qqs(i,j,l) = 0. - qqi(i,j,l) = 0. - enddo - enddo - enddo -! -!----------------------------------------------------------------------------- -! get post fields -!----------------------------------------------------------------------------- -! - foundland = .false. - foundice = .false. - get_lsmsk: do ibdl=1, wrt_int_state%FBCount - -! find lans sea mask - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) - enddo - enddo - foundland = .true. - endif - -! find ice fraction - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - sice(i,j) = arrayr42d(i,j) - if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 - enddo - enddo - foundice = .true. - endif - - enddo get_lsmsk - if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount -! - file_loop_all: do ibdl=1, wrt_int_state%FBCount -! -! get grid dimension count -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) - allocate(fcstField(ncount_field)) - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - - do n=1, ncount_field -! - call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (index(trim(fieldname),"vector") >0) cycle -! -!** for 2D fields - if (fieldDimCount == 2) then - - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) - do j=jsta, jend - do i=ista, iend - arrayr42d(i,j) = arrayr82d(i,j) - enddo - enddo - endif - - ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) - do j=jsta,jend - do i=ista, iend - fis(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! Surface pressure -! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) -! do j=jsta,jend -! do i=ista, iend -! pint(i,j) = arrayr42d(i,j) -! enddo -! enddo -! endif - - ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblh(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) - do j=jsta,jend - do i=ista, iend - ustar(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) - do j=jsta,jend - do i=ista, iend - z0(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcexc(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) - do j=jsta,jend - do i=ista, iend - acond(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - ths(i,j) = arrayr42d(i,j) - endif - enddo - enddo - endif - - ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 - enddo - enddo - endif - - ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 - endif - enddo - enddo - endif - - ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 - endif - enddo - enddo - endif - - ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 - endif - enddo - enddo - endif - - ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) - endif - enddo - enddo - endif - - ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) - endif - enddo - enddo - endif - - ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval - enddo - enddo - endif - - ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval - if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. - enddo - enddo - endif - - ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval - if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 - enddo - enddo - endif - - ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - tshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - qshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgalbedo(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgalbedo(i,j) = avgalbedo(i,j) * 0.01 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgtcdc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgtcdc(i,j) = avgtcdc(i,j) * 0.01 - endif - enddo - enddo - endif - - ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) - do j=jsta,jend - do i=ista, iend - mxsnal(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - mxsnal(i,j) = mxsnal(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfrach(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfrach(i,j) = avgcfrach(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracl(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracl(i,j) = avgcfracl(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracm(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracm(i,j) = avgcfracm(i,j) * 0.01 - endif - enddo - enddo - endif - - ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - cnvcfr(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - cnvcfr(i,j) = cnvcfr(i,j) * 0.01 - endif - enddo - enddo - endif - - ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - islope(i,j) = nint(arrayr42d(i,j)) - else - islope(i,j) = 0 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - cmc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 - if (sm(i,j) /= 0.0) cmc(i,j) = spval - enddo - enddo - endif - - ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - !set range within (0,1) - sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) - else - sr(i,j) = spval - endif - enddo - enddo - endif - - ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) - do j=jsta,jend - do i=ista,iend - if (arrayr42d(i,j) /= spval) then - ti(i,j) = arrayr42d(i,j) - if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval - else - ti(i,j) = spval - endif - enddo - enddo - endif - - ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - vegfrc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - vegfrc(i,j) = vegfrc(i,j) * 0.01 - else - vegfrc(i,j) = 0.0 - endif - if (sm(i,j) /= 0.0) vegfrc(i,j) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,1) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,2) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,3) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,4) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,1) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,2) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,3) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,4) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval - enddo - enddo - endif - - ! time averaged incoming sfc longwave - if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rlwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwout(i,j) = arrayr42d(i,j) - if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) - do j=jsta,jend - do i=ista, iend - radot(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswout(i,j) = arrayr42d(i,j) - if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswout(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswintoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface sensible heat flux, multiplied by -1 because - ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcshx(i,j) = arrayr42d(i,j) - if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) - enddo - enddo - endif - - ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - twbs(i,j) = arrayr42d(i,j) - if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) - enddo - enddo - endif - - ! time averaged surface latent heat flux, multiplied by -1 because - ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfclhx(i,j) = arrayr42d(i,j) - if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) - enddo - enddo - endif - - ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - qwbs(i,j) = arrayr42d(i,j) - if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) - enddo - enddo - endif - - ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval - enddo - enddo - endif - - ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval - enddo - enddo - endif - - ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcvx(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtaux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtauy(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval - enddo - enddo - endif - - ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval - enddo - enddo - endif - - ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) - do j=jsta,jend - do i=ista, iend - u10(i,j) = arrayr42d(i,j) - u10h(i,j) = u10(i,j) - enddo - enddo - endif - - ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) - do j=jsta,jend - do i=ista, iend - v10(i,j) = arrayr42d(i,j) - v10h(i,j) = v10(i,j) - enddo - enddo - endif - - ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - ivgtyp(i,j) = nint(arrayr42d(i,j)) - else - ivgtyp(i,j) = 0 - endif - enddo - enddo - endif - - ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - isltyp(i,j) = nint(arrayr42d(i,j)) - else - isltyp(i,j) = 0 - endif - enddo - enddo - endif - - ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptop(i,j) = arrayr42d(i,j) - if(ptop(i,j) <= 0.0) ptop(i,j) = spval - enddo - enddo - endif - - ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbot(i,j) = arrayr42d(i,j) - if(pbot(i,j) <= 0.0) pbot(i,j) = spval - enddo - enddo - endif - - ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) - do j=jsta,jend - do i=ista, iend - pboth(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblcfr(i,j) = arrayr42d(i,j) - if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 - enddo - enddo - endif - - ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) - do j=jsta,jend - do i=ista, iend - cldwork(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - runoff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) runoff(i,j) = spval - enddo - enddo - endif - - ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxtshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - mintshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) - do j=jsta,jend - do i=ista, iend - dzice(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smcwlt(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smcwlt(i,j) = spval - enddo - enddo - endif - - ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) - do j=jsta,jend - do i=ista, iend - suntime(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - fieldcapa(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval - enddo - enddo - endif - - ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - minqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - ssroff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) ssroff(i,j) = spval - enddo - enddo - endif - - ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgedir(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgedir(i,j) = spval - enddo - enddo - endif - - ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgecan(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgecan(i,j) = spval - enddo - enddo - endif - - ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgetrans(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgetrans(i,j) = spval - enddo - enddo - endif - - ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval - enddo - enddo - endif - - ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smstot(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smstot(i,j) = spval - enddo - enddo - endif - - ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - snopcx(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) snopcx(i,j) = spval - enddo - enddo - endif - -! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) - arrayr43d = 0. - do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) - do j=jsta,jend - do i=ista,iend - arrayr43d(i,j,k) = arrayr83d(i,j,k) - enddo - enddo - enddo - endif - - ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - t(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - - !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) - do j=jsta,jend - do i=ista, iend - tlmh = t(i,j,lm) * t(i,j,lm) - sigt4(i,j) = 5.67E-8 * tlmh * tlmh - enddo - enddo - endif - - ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - -! for GFDL or MG3 MP -! ------------------ - if (imp_physics == 10 .or. imp_physics == 11) then - ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif ! for MG3 MP - - ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo -! print *,'in gfs_post, get ref_10cm=',maxval(ref_10cm), minval(ref_10cm) - endif - - ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif -!3d fields - endif - - enddo ! end loop ncount_field - - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & - setvar_atmfile = .true. - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) & - setvar_sfcfile = .true. - deallocate(fcstField) - -! end file_loop_all - enddo file_loop_all - -! recompute full layer of zint -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) - do j=jsta,jend - do i=1,im - if (fis(i,j) /= spval) then - zint(i,j,lp1) = fis(i,j) - fis(i,j) = fis(i,j) * grav - endif - enddo - enddo - - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) - do j=jsta,jend - do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) - zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) - enddo - enddo - enddo - -! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) - do j=jsta,jend - do i=1,im - pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo - - do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) - do j=jsta,jend - do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) -!compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) - enddo - enddo - enddo - -! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) - -! compute alpint - do l=lp1,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) - do j=jsta,jend - do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo - -! compute zmid - do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) - do j=jsta,jend - do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo -! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & -! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & -! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & -! 'pmid=',maxval(pmid(1:im,jsta:jend,1)),minval(pmid(1:im,jsta:jend,1)), & -! 'alpint=',maxval(alpint(1:im,jsta:jend,2)),minval(alpint(1:im,jsta:jend,2)) -! print *,'in post_gfs,alpint=',maxval(alpint(1:im,jsta:jend,1)), & -! minval(alpint(1:im,jsta:jend,1)) - -! surface potential T, and potential T at roughness length -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,lp1,sm,ths,sst,thz0,pint) - do j=jsta,jend - do i=ista, iend - !assign sst - if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then - sst(i,j) = ths(i,j) - else - sst(i,j) = spval - endif - if (ths(i,j) /= spval) then - ths(i,j) = ths(i,j)* (p1000/pint(i,j,lp1))**capa - thz0(i,j) = ths(i,j) - endif - enddo - enddo - -! compute cwm for gfdlmp or MG3 - if( imp_physics == 10 .or. imp_physics == 11) then - do l=1,lm -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) - do j=jsta,jend - do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) - enddo - enddo - enddo - endif - -! estimate 2m pres and convert t2m to theta -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) - do j=jsta,jend - do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA - enddo - enddo - -!htop - do j=jsta,jend - do i=1,im - htop(i,j) = spval - if(ptop(i,j) < spval)then - do l=1,lm - if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l - exit - endif - enddo - endif - enddo - enddo - -! hbot - do j=jsta,jend - do i=1,im - if(pbot(i,j) < spval)then - do l=lm,1,-1 - if(pbot(i,j) >= pmid(i,j,l)) then - hbot(i,j) = l - exit - end if - end do - end if - end do - end do - -! generate look up table for lifted parcel calculations - thl = 210. - plq = 70000. - pt_tbl = 10000. ! this is for 100 hPa added by Moorthi - - call table(ptbl,ttbl,pt_tbl, & - rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0) - - call tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q) - - if(mype == 0)then - write(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - write(6,51) (SPL(L),L=1,LSM) - 50 format(14(F4.1,1X)) - 51 format(8(F8.1,1X)) - endif -! -!$omp parallel do default(none) private(l) shared(lsm,alsl,spl) - do l = 1,lsm - alsl(l) = log(spl(l)) - end do -! -! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) -!!! above is fv3 change -! -!more fields need to be computed -! - end subroutine set_postvars_gfs - - - end module post_gfs diff --git a/io/post_gfs.F90_v16 b/io/post_gfs.F90_v16 deleted file mode 100644 index 76dd0251c..000000000 --- a/io/post_gfs.F90_v16 +++ /dev/null @@ -1,2473 +0,0 @@ -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! -module post_gfs - - use module_fv3_io_def, only : wrttasks_per_group,filename_base - use write_internal_state, only : wrt_internal_state - - implicit none - - include 'mpif.h' - - integer mype, nbdl - logical setvar_atmfile, setvar_sfcfile, read_postcntrl - public post_run_gfs, post_getattr_gfs - - contains - - subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & - mynfhr,mynfmin,mynfsec) -! -! revision history: -! Jul 2019 J. Wang create interface to run inline post for FV3 -! -!----------------------------------------------------------------------- -!*** run post on write grid comp -!----------------------------------------------------------------------- -! - use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & - npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat - use gridspec_mod, only : maptype, gridtype - use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl - use xml_perl_data,only : paramset -! -!----------------------------------------------------------------------- -! - implicit none -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mypei - integer,intent(in) :: mpicomp - integer,intent(in) :: lead_write - integer,intent(in) :: mynfhr - integer,intent(in) :: mynfmin - integer,intent(in) :: mynfsec -! -!----------------------------------------------------------------------- -!*** LOCAL VARIABLES -!----------------------------------------------------------------------- -! - integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil - integer,allocatable :: jstagrp(:),jendgrp(:) - integer,save :: kpo,kth,kpv - logical,save :: log_postalct=.false. - real,dimension(komax),save :: po, th, pv - logical :: Log_runpost - character(255) :: post_fname*255 - - integer,save :: iostatusD3D=-1 -! - real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 -! -! print *,'in post_run start' -!----------------------------------------------------------------------- -!*** set up dimensions -!----------------------------------------------------------------------- -! - btim0 = MPI_Wtime() - - modelname = "GFS" - grib = "grib2" - gridtype = "A" - nsoil = 4 - mype = mypei - nwtpg = wrt_int_state%petcount - jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection - jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection - maptype = wrt_int_state%post_maptype - nbdl = wrt_int_state%FBCount - - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & - 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct - -! -!----------------------------------------------------------------------- -!*** set up fields to run post -!----------------------------------------------------------------------- -! - if (.not.log_postalct) then -! - allocate(jstagrp(nwtpg),jendgrp(nwtpg)) -! - do n=0,nwtpg-1 - jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) - jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) - enddo - if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp - -!----------------------------------------------------------------------- -!*** read namelist for pv,th,po -!----------------------------------------------------------------------- -! - call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_nlunit, & - wrt_int_state%post_namelist) -! -!----------------------------------------------------------------------- -!*** allocate post variables -!----------------------------------------------------------------------- -! -! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & -! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) -! -!----------------------------------------------------------------------- -!*** read namelist for pv,th,po -!----------------------------------------------------------------------- -! - log_postalct = .true. - first_grbtbl = .true. - read_postcntrl = .true. -! - ENDIF -! -!----------------------------------------------------------------------- -!*** fill post variables with values from forecast results -!----------------------------------------------------------------------- -! - ifhr = mynfhr - ifmin = mynfmin - if (ifhr == 0 ) ifmin = 0 - if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. - call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) - -! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & -! 'setvar_sfcfile=',setvar_sfcfile -! - if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP -! call MICROINIT -! - if(grib=="grib2" .and. read_postcntrl) then - if (ifhr == 0) then - filenameflat = 'postxconfig-NT_FH00.txt' - call read_xml() - if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat) - else if(ifhr > 0) then - filenameflat = 'postxconfig-NT.txt' - if(size(paramset)>0) then - do i=1,size(paramset) - if (size(paramset(i)%param)>0) then - deallocate(paramset(i)%param) - nullify(paramset(i)%param) - endif - enddo - deallocate(paramset) - nullify(paramset) - endif - num_pset = 0 - call read_xml() - if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr - read_postcntrl = .false. - endif - endif -! - IEOF = 0 - npset = 0 - icount_calmict = 0 - do while( IEOF == 0) -! - if(grib == "grib2") then - npset = npset + 1 - call set_outflds(kth,th,kpv,pv) - if(allocated(datapd))deallocate(datapd) - allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) -!$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) - do k=1,nrecout+100 - do j=1,jend+1-jsta - do i=1,im - datapd(i,j,k) = 0. - enddo - enddo - enddo - call get_postfilename(post_fname) - if (mype==0) write(0,*)'post_fname=',trim(post_fname) -! - if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) -! - call mpi_barrier(mpicomp,ierr) - call gribit2(post_fname) - if(allocated(datapd))deallocate(datapd) - if(allocated(fld_info))deallocate(fld_info) - if(npset >= num_pset) exit - - endif -! - enddo -! - endif - - end subroutine post_run_gfs -! -!----------------------------------------------------------------------- -! - subroutine post_getattr_gfs(wrt_int_state, fldbundle) -! - use esmf - use ctlblk_mod, only: im, jm, mpi_comm_comp - use masks, only: gdlat, gdlon, dx, dy - use gridspec_mod, only: latstart, latlast, lonstart, & - lonlast, cenlon, cenlat -! - implicit none -! - type(wrt_internal_state),intent(inout) :: wrt_int_state - type(ESMF_FieldBundle), intent(in) :: fldbundle -! -! local variable - integer i,j,k,n,kz, attcount - integer ni,naryi,nr4,nr8,rc - integer aklen,varival - real(4) varr4val - real(8) varr8val - character(80) attName, hydrostatics, fldname - type(ESMF_TypeKind_Flag) :: typekind - real(4), dimension(:), allocatable :: ak4,bk4 - real(8), dimension(:), allocatable :: ak8,bk8 -! -! look at the field bundle attributes - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out -! - aklen=0. - do i=1, attCount - - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out - - if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival - endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr4val - endif - else if(n>1) then - if(trim(attName) =="ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr8val - endif - else if(n>1) then - if(trim(attName) =="ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - wrt_int_state%lm = size(wrt_int_state%ak) - 1 - endif - endif -! - enddo -! print *,'in post_getattr, dtp=',wrt_int_state%dtp -! - end subroutine post_getattr_gfs -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! - subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) -! -! revision history: -! Jul 2019 J. Wang Initial code -! -!----------------------------------------------------------------------- -!*** set up post fields from nmint_state -!----------------------------------------------------------------------- -! - use esmf - use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & - qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & - q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm - use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& - qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& - cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& - avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, & - cfrach, cfracl, cfracm, avgcfrach, qshltr, & - avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& - vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, & - rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & - rswinc, rswout, aswin, auvbin, auvbinc, aswout, & - aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & - sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, & - smstav, smstot, ivgtyp, isltyp, sfcevp, sfcexc, & - acsnow, acsnom, sst, thz0, qz0, uz0, vz0, ptop, & - htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, & - pbotm, ttopm, ptoph, pboth, pblcfr, ttoph, runoff,& - maxtshltr, mintshltr, maxrhshltr, minrhshltr, & - dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, & - htops, hbots, aswintoa, maxqshltr, minqshltr, & - acond, sr, u10h, v10h, avgedir, avgecan, & - avgetrans, avgesnow, avgprec_cont, avgcprate_cont,& - avisbeamswin, avisdiffswin, airbeamswin, airdiffswin, & - alwoutc, alwtoac, aswoutc, aswtoac, alwinc, aswinc,& - avgpotevp, snoavg, ti, si, cuppt - use soil, only: sldpth, sh2o, smc, stc - use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice - use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & - ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst - use params_mod, only: erad, dtr, capa, p1000 - use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & - qs0, sqs, sthe, ttblq, rdpq, rdtheq, stheq, the0q, the0 - use physcons, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & - eps => con_eps, epsm1 => con_epsm1 - use rqstfld_mod -! -! use write_internal_state, only: wrt_internal_state -! -!----------------------------------------------------------------------- -! - implicit none -! - include 'mpif.h' -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mpicomp - logical,intent(inout) :: setvar_atmfile,setvar_sfcfile -! -!----------------------------------------------------------------------- -! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend - integer ista,iend,fieldDimCount,gridDimCount,ncount_field - integer jdate(8) - logical foundland, foundice, found - real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp - real, dimension(:),allocatable :: ak5, bk5 - real(4),dimension(:,:),pointer :: arrayr42d - real(8),dimension(:,:),pointer :: arrayr82d - real(4),dimension(:,:,:),pointer :: arrayr43d - real(8),dimension(:,:,:),pointer :: arrayr83d - real,dimension(:), allocatable :: slat,qstl - real,external::FPVSNEW - real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & - cw2d, cfr2d - character(len=80) :: fieldname, wrtFBName - type(ESMF_Grid) :: wrtGrid - type(ESMF_Field) :: theField - type(ESMF_Field), allocatable :: fcstField(:) - type(ESMF_TypeKind_Flag) :: typekind -! -!----------------------------------------------------------------------- -!*** INTEGER SCALAR/1D HISTORY VARIABLES -!----------------------------------------------------------------------- -! - imp_physics = wrt_int_state%imp_physics !set GFS mp physics to 99 for Zhao scheme - dtp = wrt_int_state%dtp - iSF_SURFACE_PHYSICS = 2 - spval = 9.99e20 - -! -! nems gfs has zhour defined - tprec = float(wrt_int_state%fhzero) - tclod = tprec - trdlw = tprec - trdsw = tprec - tsrfc = tprec - tmaxmin = tprec - td3d = tprec - if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & - 'dtp=',dtp,'tmaxmin=',tmaxmin - -! write(6,*) 'maptype and gridtype is ', maptype,gridtype -! -!$omp parallel do default(shared),private(i,j) - do j=jsta,jend - do i=1,im - gdlat(i,j) = wrt_int_state%latPtr(i,j) - gdlon(i,j) = wrt_int_state%lonPtr(i,j) - enddo - enddo -! - lonstart = nint(wrt_int_state%lonstart*gdsdegr) - lonlast = nint(wrt_int_state%lonlast*gdsdegr) - latstart = nint(wrt_int_state%latstart*gdsdegr) - latlast = nint(wrt_int_state%latlast*gdsdegr) -! print*,'latstart,latlast B bcast= ',latstart,latlast -! print*,'lonstart,lonlast B bcast= ',lonstart,lonlast - -!$omp parallel do default(none),private(i,j,ip1), & -!$omp& shared(jsta,jend_m,im,dx,gdlat,gdlon,dy) - do j = jsta, jend_m - do i = 1, im - ip1 = i + 1 - if (ip1 > im) ip1 = ip1 - im - dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr - dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH - end do - end do -! - if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) - do i=1,lm+1 - ak5(i) = wrt_int_state%ak(i) - bk5(i) = wrt_int_state%bk(i) - enddo - -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,f,gdlat) - do j=jsta,jend - do i=1,im - f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) - end do - end do -! -! GFS does not output PD - pt = ak5(1) - -! GFS may not have model derived radar ref. -! TKE -! cloud amount -!$omp parallel do default(none),private(i,j,l), & -!$omp& shared(lm,jsta,jend,im,spval,ref_10cm,q2,cfr) - do l=1,lm - do j=jsta,jend - do i=1,im - ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL - cfr(i,j,l) = SPVAL - enddo - enddo - enddo - -! GFS does not have surface specific humidity -! inst sensible heat flux -! inst latent heat flux -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) - do j=jsta,jend - do i=1,im - qs(i,j) = SPVAL - twbs(i,j) = SPVAL - qwbs(i,j) = SPVAL - ths(i,j) = SPVAL - enddo - enddo - -! GFS set up DT to compute accumulated fields, set it to one - dtq2 = wrt_int_state%dtp - nphs = 2. - dt = dtq2/nphs -! -! GFS does not have convective cloud efficiency -! similated precip -! 10 m theta -! 10 m humidity -! snow free albedo -!$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) - do j=jsta,jend - do i=1,im - cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL - albase(i,j) = SPVAL - enddo - enddo - -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. - enddo - enddo - -! GFS probably does not use zenith angle, czen, czmean -! inst surface outgoing longwave, radot -! inst cloud fraction for high, middle, and low cloud, -! cfrach -! inst ground heat flux, grnflx -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval), & -!$omp& shared(czen,czmean,radot,cfrach,cfracl,cfracm,grnflx) - do j=jsta,jend - do i=1,im - czen(i,j) = SPVAL - czmean(i,j) = SPVAL - radot(i,j) = SPVAL - cfrach(i,j) = SPVAL - cfracl(i,j) = SPVAL - cfracm(i,j) = SPVAL - grnflx(i,j) = SPVAL - enddo - enddo -! -! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam - sldpth(1) = 0.10 - sldpth(2) = 0.3 - sldpth(3) = 0.6 - sldpth(4) = 1.0 - -! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, n -! cfrcv to 1 -! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 -! UNDERGROUND RUNOFF, bgroff -! inst incoming sfc longwave, rlwin -! inst model top outgoing longwave,rlwtoa -! inst incoming sfc shortwave, rswin -! inst incoming clear sky sfc shortwave, rswinc -! inst outgoing sfc shortwave, rswout -! snow phase change heat flux, snopcx -! GFS does not use total momentum flux,sfcuvx -!$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwin,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) - do j=jsta,jend - do i=1,im - acfrcv(i,j) = spval - ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval - ncfrst(i,j) = 1.0 - bgroff(i,j) = spval - rlwin(i,j) = spval - rlwtoa(i,j) = spval - rswin(i,j) = spval - rswinc(i,j) = spval - rswout(i,j) = spval - snopcx(i,j) = spval - sfcuvx(i,j) = spval - enddo - enddo - -! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 - ardlw = 1.0 -! GFS incoming sfc longwave has been averaged, set ARDLW to 1 - ardsw = 1.0 -! GFS surface flux has been averaged, set ASRFC to 1 - asrfc = 1.0 - -! GFS does not have temperature tendency due to long wave radiation -! temperature tendency due to short wave radiation -! temperature tendency due to latent heating from convection -! temperature tendency due to latent heating from grid scale - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval,l), & -!$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) - do j=jsta_2l,jend_2u - do i=1,im - rlwtt(i,j,l) = spval - rswtt(i,j,l) = spval - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval - train(i,j,l) = spval - enddo - enddo - enddo - -! set avrain to 1 - avrain = 1.0 - avcnvc = 1.0 - theat = 6.0 ! just in case GFS decides to output T tendency - -! GFS does not have temperature tendency due to latent heating from grid scale - train = spval - -! GFS does not have soil moisture availability, smstav -! accumulated surface evaporatio, sfcevp -! averaged accumulated snow, acsnow -! snow melt,acsnom -! humidity at roughness length, qz0 -! u at roughness length, uz0 -! v at roughness length, vz0 -! shelter rh max, maxrhshltr -! shelter rh min, minrhshltr -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(smstav,sfcevp,acsnow,acsnom,qz0,uz0,vz0,maxrhshltr,minrhshltr) - do j=jsta_2l,jend_2u - do i=1,im - smstav(i,j) = spval - sfcevp(i,j) = spval - acsnow(i,j) = spval - acsnom(i,j) = spval - qz0(i,j) = spval - uz0(i,j) = spval - vz0(i,j) = spval - maxrhshltr(i,j) = SPVAL - minrhshltr(i,j) = SPVAL - enddo - enddo - -! GFS does not have mixing length,el_pbl -! exchange coefficient, exch_h - do l=1,lm -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,l,spval,el_pbl,exch_h) - do j=jsta_2l,jend_2u - do i=1,im - el_pbl(i,j,l) = spval - exch_h(i,j,l) = spval - enddo - enddo - enddo - -! GFS does not have deep convective cloud top and bottom fields -!$omp parallel do default(none),private(i,j),shared(jsta_2l,jend_2u,im,spval), & -!$omp& shared(htopd,hbotd,htops,hbots,cuppt) - do j=jsta_2l,jend_2u - do i=1,im - htopd(i,j) = SPVAL - hbotd(i,j) = SPVAL - htops(i,j) = SPVAL - hbots(i,j) = SPVAL - cuppt(i,j) = SPVAL - enddo - enddo -! -! get inital date - sdat(1) = wrt_int_state%idate(2) !month - sdat(2) = wrt_int_state%idate(3) !day - sdat(3) = wrt_int_state%idate(1) !year - ihrst = wrt_int_state%idate(4) !hour - - idat(1) = wrt_int_state%fdate(2) - idat(2) = wrt_int_state%fdate(3) - idat(3) = wrt_int_state%fdate(1) - idat(4) = wrt_int_state%fdate(4) - idat(5) = wrt_int_state%fdate(5) -! - if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst -! CALL W3DIFDAT(JDATE,IDATE,0,RINC) -! -! if(mype==0)print *,' rinc=',rinc -! ifhr = nint(rinc(2)+rinc(1)*24.) -! if(mype==0)print *,' ifhr=',ifhr -! ifmin = nint(rinc(3)) -! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop -! if(mype==0)print*,' in INITPOST ifhr ifmin =',ifhr,ifmin -! - tstart = 0. -! -!** initialize cloud water and ice mixing ratio -!$omp parallel do default(none),private(i,j,l),shared(lm,jsta,jend,im), & -!$omp& shared(qqw,qqr,qqs,qqi) - do l = 1,lm - do j = jsta, jend - do i = 1,im - qqw(i,j,l) = 0. - qqr(i,j,l) = 0. - qqs(i,j,l) = 0. - qqi(i,j,l) = 0. - enddo - enddo - enddo -! -!----------------------------------------------------------------------------- -! get post fields -!----------------------------------------------------------------------------- -! - foundland = .false. - foundice = .false. - get_lsmsk: do ibdl=1, wrt_int_state%FBCount - -! find lans sea mask - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) - enddo - enddo - foundland = .true. - endif - -! find ice fraction - found = .false. - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out -! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found - if (found) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - ista = lbound(arrayr42d,1) - iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) - do j=jsta, jend - do i=ista, iend - sice(i,j) = arrayr42d(i,j) - if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 - enddo - enddo - foundice = .true. - endif - - enddo get_lsmsk - if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - endif - if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount -! - file_loop_all: do ibdl=1, wrt_int_state%FBCount -! -! get grid dimension count -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) - allocate(fcstField(ncount_field)) - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - -! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field -! - call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - if (index(trim(fieldname),"vector") >0) cycle -! -!** for 2D fields - if (fieldDimCount == 2) then - - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) - do j=jsta, jend - do i=ista, iend - arrayr42d(i,j) = arrayr82d(i,j) - enddo - enddo - endif - - ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) - do j=jsta,jend - do i=ista, iend - fis(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! Surface pressure -! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) -! do j=jsta,jend -! do i=ista, iend -! pint(i,j)=arrayr42d(i,j) -! enddo -! enddo -! endif - - ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblh(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) - do j=jsta,jend - do i=ista, iend - ustar(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) - do j=jsta,jend - do i=ista, iend - z0(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcexc(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) - do j=jsta,jend - do i=ista, iend - acond(i,j)=arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - ths(i,j) = arrayr42d(i,j) - endif - enddo - enddo - endif - - ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) - enddo - enddo - endif - - ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) - endif - enddo - enddo - endif - - ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp - endif - enddo - enddo - endif - - ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp - endif - enddo - enddo - endif - - ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval - enddo - enddo - endif - - ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval - if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. - enddo - enddo - endif - - ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval - if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 - enddo - enddo - endif - - ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - tshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - qshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgalbedo(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgalbedo(i,j) = avgalbedo(i,j) * 0.01 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgtcdc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgtcdc(i,j) = avgtcdc(i,j) * 0.01 - endif - enddo - enddo - endif - - ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) - do j=jsta,jend - do i=ista, iend - mxsnal(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - mxsnal(i,j) = mxsnal(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfrach(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfrach(i,j) = avgcfrach(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracl(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracl(i,j) = avgcfracl(i,j) * 0.01 - endif - enddo - enddo - endif - - ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) - do j=jsta,jend - do i=ista, iend - avgcfracm(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - avgcfracm(i,j) = avgcfracm(i,j) * 0.01 - endif - enddo - enddo - endif - - ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - cnvcfr(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - cnvcfr(i,j) = cnvcfr(i,j) * 0.01 - endif - enddo - enddo - endif - - ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - islope(i,j) = nint(arrayr42d(i,j)) - else - islope(i,j) = 0 - endif - enddo - enddo - endif - - ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - cmc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 - if (sm(i,j) /= 0.0) cmc(i,j) = spval - enddo - enddo - endif - - ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) /= spval) then - !set range within (0,1) - sr(i,j) = min(1.,max(0.,arrayr42d(i,j))) - else - sr(i,j) = spval - endif - enddo - enddo - endif - - ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) - do j=jsta,jend - do i=ista,iend - if (arrayr42d(i,j) /= spval) then - ti(i,j) = arrayr42d(i,j) - if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval - else - ti(i,j) = spval - endif - enddo - enddo - endif - - ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - vegfrc(i,j) = arrayr42d(i,j) - if (arrayr42d(i,j) /= spval) then - vegfrc(i,j) = vegfrc(i,j) * 0.01 - else - vegfrc(i,j) = 0.0 - endif - if (sm(i,j) /= 0.0) vegfrc(i,j) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval - enddo - enddo - endif - - ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - sh2o(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,1) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,1) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,2) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,2) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,3) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,3) = spval - enddo - enddo - endif - - ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smc(i,j,4) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smc(i,j,4) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,1) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,2) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,3) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval - enddo - enddo - endif - - ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - stc(i,j,4) = arrayr42d(i,j) - !mask open water areas, combine with sea ice tmp - if (sm(i,j) /= 0.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval - enddo - enddo - endif - - ! time averaged incoming sfc longwave - if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rlwin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwout(i,j) = arrayr42d(i,j) - if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) - do j=jsta,jend - do i=ista, iend - radot(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - auvbinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswout(i,j) = arrayr42d(i,j) - if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) - enddo - enddo - endif - - ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) - do j=jsta,jend - do i=ista, iend - rswout(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswintoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoa(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface sensible heat flux, multiplied by -1 because - ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcshx(i,j) = arrayr42d(i,j) - if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) - enddo - enddo - endif - - ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - twbs(i,j) = arrayr42d(i,j) - if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j) - enddo - enddo - endif - - ! time averaged surface latent heat flux, multiplied by -1 because - ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfclhx(i,j) = arrayr42d(i,j) - if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) - enddo - enddo - endif - - ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) - do j=jsta,jend - do i=ista, iend - qwbs(i,j) = arrayr42d(i,j) - if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j) - enddo - enddo - endif - - ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval - enddo - enddo - endif - - ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval - enddo - enddo - endif - - ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) - do j=jsta,jend - do i=ista, iend - sfcvx(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtaux(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) - do j=jsta,jend - do i=ista, iend - gtauy(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval - enddo - enddo - endif - - ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval - enddo - enddo - endif - - ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) - do j=jsta,jend - do i=ista, iend - u10(i,j) = arrayr42d(i,j) - u10h(i,j) = u10(i,j) - enddo - enddo - endif - - ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) - do j=jsta,jend - do i=ista, iend - v10(i,j) = arrayr42d(i,j) - v10h(i,j) = v10(i,j) - enddo - enddo - endif - - ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - ivgtyp(i,j) = nint(arrayr42d(i,j)) - else - ivgtyp(i,j) = 0 - endif - enddo - enddo - endif - - ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) - do j=jsta,jend - do i=ista, iend - if (arrayr42d(i,j) < spval) then - isltyp(i,j) = nint(arrayr42d(i,j)) - else - isltyp(i,j) = 0 - endif - enddo - enddo - endif - - ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptop(i,j) = arrayr42d(i,j) - if(ptop(i,j) <= 0.0) ptop(i,j) = spval - enddo - enddo - endif - - ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbot(i,j) = arrayr42d(i,j) - if(pbot(i,j) <= 0.0) pbot(i,j) = spval - enddo - enddo - endif - - ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopl(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) - do j=jsta,jend - do i=ista, iend - pbotm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttopm(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ptoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) - do j=jsta,jend - do i=ista, iend - pboth(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) - do j=jsta,jend - do i=ista, iend - ttoph(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) - do j=jsta,jend - do i=ista, iend - pblcfr(i,j) = arrayr42d(i,j) - if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 - enddo - enddo - endif - - ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) - do j=jsta,jend - do i=ista, iend - cldwork(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - runoff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) runoff(i,j) = spval - enddo - enddo - endif - - ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxtshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - mintshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) - do j=jsta,jend - do i=ista, iend - dzice(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smcwlt(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smcwlt(i,j) = spval - enddo - enddo - endif - - ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) - do j=jsta,jend - do i=ista, iend - suntime(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - fieldcapa(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval - enddo - enddo - endif - - ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - avisdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airbeamswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) - do j=jsta,jend - do i=ista, iend - airdiffswin(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswoutc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswtoac(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - alwinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) - do j=jsta,jend - do i=ista, iend - aswinc(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - maxqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) - do j=jsta,jend - do i=ista, iend - minqshltr(i,j) = arrayr42d(i,j) - enddo - enddo - endif - - ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - ssroff(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) ssroff(i,j) = spval - enddo - enddo - endif - - ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgedir(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgedir(i,j) = spval - enddo - enddo - endif - - ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgecan(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgecan(i,j) = spval - enddo - enddo - endif - - ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - avgetrans(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) avgetrans(i,j) = spval - enddo - enddo - endif - - ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) - do j=jsta,jend - do i=ista, iend - avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval - enddo - enddo - endif - - ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - smstot(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) smstot(i,j) = spval - enddo - enddo - endif - - ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) - do j=jsta,jend - do i=ista, iend - snopcx(i,j) = arrayr42d(i,j) - if (sm(i,j) /= 0.0) snopcx(i,j) = spval - enddo - enddo - endif - -! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then - if (typekind == ESMF_TYPEKIND_R4) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - else if (typekind == ESMF_TYPEKIND_R8) then - call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out - allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) - arrayr43d = 0. - do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) - do j=jsta,jend - do i=ista,iend - arrayr43d(i,j,k) = arrayr83d(i,j,k) - enddo - enddo - enddo - endif - - ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - t(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - - !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) - do j=jsta,jend - do i=ista, iend - tlmh = t(i,j,lm) * t(i,j,lm) - sigt4(i,j) = 5.67E-8 * tlmh * tlmh - enddo - enddo - endif - - ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - -! for GFDL MP - if (imp_physics == 11) then - ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif -!gfdlmp - endif - - ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo -! print *,'in gfs_post, get ref_10cm=',maxval(ref_10cm), minval(ref_10cm) - endif - - ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) - enddo - enddo - enddo - endif -!3d fields - endif - -! end loop ncount_field - enddo - - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & - setvar_atmfile = .true. - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) & - setvar_sfcfile = .true. - deallocate(fcstField) - -! end file_loop_all - enddo file_loop_all - -! recompute full layer of zint -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,lp1,spval,zint,fis) - do j=jsta,jend - do i=1,im - if (fis(i,j) /= spval) then - zint(i,j,lp1) = fis(i,j) - fis(i,j) = fis(i,j) * grav - endif - enddo - enddo - - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) - do j=jsta,jend - do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) - zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) - enddo - enddo - enddo - -! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) - do j=jsta,jend - do i=1,im - pint(i,j,1) = ak5(1) - end do - end do - - do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) - do j=jsta,jend - do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - -!compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) - enddo - enddo - enddo - -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do -! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) - -! compute alpint - do l=lp1,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) - do j=jsta,jend - do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do - -! compute zmid - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) - do j=jsta,jend - do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do -! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & -! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & -! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & -! 'pmid=',maxval(pmid(1:im,jsta:jend,1)),minval(pmid(1:im,jsta:jend,1)), & -! 'alpint=',maxval(alpint(1:im,jsta:jend,2)),minval(alpint(1:im,jsta:jend,2)) -! print *,'in post_gfs,alpint=',maxval(alpint(1:im,jsta:jend,1)), & -! minval(alpint(1:im,jsta:jend,1)) - -! surface potential T, and potential T at roughness length -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,lp1,sm,ths,sst,thz0,pint) - do j=jsta,jend - do i=ista, iend - !assign sst - if (sm(i,j) /= 0.0 .and. ths(i,j) /= spval) then - sst(i,j) = ths(i,j) - else - sst(i,j) = spval - endif - if (ths(i,j) /= spval) then - ths(i,j) = ths(i,j)* (p1000/pint(i,j,lp1))**capa - thz0(i,j) = ths(i,j) - endif - enddo - enddo - -! compute cwm for gfdlmp - if( imp_physics == 11 ) then - do l=1,lm -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) - do j=jsta,jend - do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) - enddo - enddo - enddo - endif - -! estimate 2m pres and convert t2m to theta -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) - do j=jsta,jend - do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA - enddo - enddo - -!htop - do j=jsta,jend - do i=1,im - htop(i,j) = spval - if(ptop(i,j) < spval)then - do l=1,lm - if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l - exit - end if - end do - end if - end do - end do - -! hbot - do j=jsta,jend - do i=1,im - if(pbot(i,j) < spval)then - do l=lm,1,-1 - if(pbot(i,j) >= pmid(i,j,l)) then - hbot(i,j) = l - exit - end if - end do - end if - end do - end do - -! generate look up table for lifted parcel calculations - thl = 210. - plq = 70000. - pt_tbl = 10000. ! this is for 100 hPa added by Moorthi - - call table(ptbl,ttbl,pt_tbl, & - rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0) - - call tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q) - - if(mype == 0)then - write(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - write(6,51) (SPL(L),L=1,LSM) - 50 format(14(F4.1,1X)) - 51 format(8(F8.1,1X)) - endif -! -!$omp parallel do default(none) private(l) shared(lsm,alsl,spl) - do l = 1,lsm - alsl(l) = log(spl(l)) - end do -! -! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) -!!! above is fv3 change -! -!more fields need to be computed -! - end subroutine set_postvars_gfs - - - end module post_gfs From bcb678c74495b9c9e2f767e74e104c64a27e3705 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 21 Jun 2021 23:51:06 +0000 Subject: [PATCH 160/217] after submodule sync --- .gitmodules | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 05a2c7c6b..bc6beccee 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_May182021 + branch = SM_May302021 diff --git a/ccpp/framework b/ccpp/framework index 54b158f91..075e08e28 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 54b158f91fb0abf58ab099d4ae80a57d7f1ee0b8 +Subproject commit 075e08e2887d1dbd4fe95003689eac69aca5f32c diff --git a/ccpp/physics b/ccpp/physics index dc841aa2a..51e985f6e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit dc841aa2a591d2396ad345ff039db6bc9b3e6064 +Subproject commit 51e985f6e13de54d4a883b590f96a6e455074aea From d8316eb1a1e31911ee0f515af5de007701741e51 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Jun 2021 10:51:26 -0400 Subject: [PATCH 161/217] updates to stochastic_wrapper and atmos_model.F90 --- atmos_model.F90 | 14 +-- ccpp/data/GFS_typedefs.F90 | 3 + ccpp/physics | 2 +- .../stochastic_physics_wrapper.F90 | 112 +++++++++--------- 4 files changed, 69 insertions(+), 62 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 85c9f6e85..838335c6e 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -204,7 +204,7 @@ module atmos_model_mod contains !####################################################################### -! +! ! ! ! Called every time step as the atmospheric driver to compute the @@ -261,8 +261,8 @@ subroutine update_atmos_radiation_physics (Atmos) call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') - if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + if ((GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca) .and. GFS_Control%kdt > GFS_Control%kdt_start) then !--- call stochastic physics pattern generation / cellular automata call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') @@ -607,7 +607,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP physics_init step failed') if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca) then !--- Initialize stochastic physics pattern generation / cellular automata for first time step call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) @@ -1553,7 +1553,7 @@ subroutine assign_importdata(rc) ! real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed ! real(kind=GFS_kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required - real(kind=GFS_kind_phys), parameter :: hsmax = 2.0 !< maximum snow depth allowed + real(kind=GFS_kind_phys), parameter :: hsmax = 100.0 !< maximum snow depth (m) allowed ! !------------------------------------------------------------------------------ ! @@ -1659,7 +1659,7 @@ subroutine assign_importdata(rc) ! get sea ice surface temperature !-------------------------------- fldname = 'sea_ice_surface_temperature' - if (trim(impfield_name) == trim(fldname) .and. GFS_control%kdt > 1) then + if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) @@ -1700,7 +1700,7 @@ subroutine assign_importdata(rc) ! get sea ice fraction: fice or sea ice concentration from the mediator !----------------------------------------------------------------------- fldname = 'ice_fraction' - if (trim(impfield_name) == trim(fldname) .and. GFS_control%kdt > 1) then + if (trim(impfield_name) == trim(fldname)) then findex = queryImportFields(fldname) if (importFieldsValid(findex)) then lcpl_fice = .true. diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 848295ee9..ea53e7922 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1191,6 +1191,7 @@ module GFS_typedefs real(kind=kind_phys) :: fhour !< current forecast hour real(kind=kind_phys) :: zhour !< previous hour diagnostic buckets emptied integer :: kdt !< current forecast iteration + integer :: kdt_start !< current forecast iteration logical :: first_time_step !< flag signaling first time step for time integration routine logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) logical :: hydrostatic !< flag whether this is a hydrostatic or non-hydrostatic run @@ -4443,6 +4444,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) Model%kdt = nint(Model%fhour*con_hr/Model%dtp) + Model%kdt_start = Model%kdt Model%first_time_step = .true. Model%restart = restart Model%hydrostatic = hydrostatic @@ -5403,6 +5405,7 @@ subroutine control_print(Model) print *, ' fhour : ', Model%fhour print *, ' zhour : ', Model%zhour print *, ' kdt : ', Model%kdt + print *, ' kdt_start : ', Model%kdt_start print *, ' jdat : ', Model%jdat print *, ' si : ', Model%si print *, ' sec : ', Model%sec diff --git a/ccpp/physics b/ccpp/physics index e4528fbf3..9cdc2b525 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e4528fbf39f49ed43faffc42b597622fb78bf724 +Subproject commit 9cdc2b525083d8c4422ce4e861f3eb85866d863c diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 2a950c36f..7e6f48ffe 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -79,7 +79,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) type(block_control_type), intent(inout) :: Atm_block integer, intent(out) :: ierr - integer :: nthreads, nb + integer :: nthreads, nb, levs, maxblk, kdt_loc logical :: param_update_flag #ifdef _OPENMP @@ -89,18 +89,22 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) #endif ierr = 0 + levs = GFS_Control%levs + maxblk = maxval(GFS_Control%blksz) + kdt_loc = GFS_Control%kdt - GFS_Control%kdt_start ! Initialize - initalize_stochastic_physics: if (GFS_Control%kdt==0) then - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then - allocate(xlat(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(xlon(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + initalize_stochastic_physics: if (kdt_loc == 0) then + + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then + if (.not. allocated(xlat)) allocate(xlat(1:Atm_block%nblks,maxblk)) + if (.not. allocated(xlon)) allocate(xlon(1:Atm_block%nblks,maxblk)) do nb=1,Atm_block%nblks xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) end do ! Initialize stochastic physics - call init_stochastic_physics(GFS_Control%levs, GFS_Control%blksz, GFS_Control%dtp, GFS_Control%sppt_amp, & + call init_stochastic_physics(levs, GFS_Control%blksz, GFS_Control%dtp, GFS_Control%sppt_amp, & GFS_Control%input_nml_file, GFS_Control%fn_nml, GFS_Control%nlunit, xlon, xlat, GFS_Control%do_sppt, GFS_Control%do_shum, & GFS_Control%do_skeb, GFS_Control%lndp_type, GFS_Control%n_var_lndp, GFS_Control%use_zmtnblck, GFS_Control%skeb_npass, & GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & @@ -111,17 +115,17 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif end if if (GFS_Control%do_sppt) then - allocate(sppt_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + if (.not. allocated(sppt_wts)) allocate(sppt_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if (GFS_Control%do_shum) then - allocate(shum_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + if (.not. allocated(shum_wts)) allocate(shum_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if (GFS_Control%do_skeb) then - allocate(skebu_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) - allocate(skebv_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%levs)) + if (.not. allocated(skebu_wts)) allocate(skebu_wts(1:Atm_block%nblks,maxblk,1:levs)) + if (.not. allocated(skebv_wts)) allocate(skebv_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast - allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),1:GFS_Control%n_var_lndp)) + if (.not. allocated(sfc_wts)) allocate(sfc_wts(1:Atm_block%nblks,maxblk,1:GFS_Control%n_var_lndp)) end if if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme if (GFS_Control%lsm == GFS_Control%lsm_noah) then @@ -129,26 +133,26 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then lsoil = GFS_Control%lsoil_lsm endif - allocate(smc(1:Atm_block%nblks,maxval(GFS_Control%blksz),lsoil)) - allocate(slc(1:Atm_block%nblks,maxval(GFS_Control%blksz),lsoil)) - allocate(stc(1:Atm_block%nblks,maxval(GFS_Control%blksz),lsoil)) - allocate(stype(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(vfrac(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(snoalb(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(alvsf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(alnsf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(alvwf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(alnwf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(facsf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(facwf(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(semis(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(zorll(1:Atm_block%nblks,maxval(GFS_Control%blksz))) + if (.not. allocated(smc)) allocate(smc(1:Atm_block%nblks,maxblk,lsoil)) + if (.not. allocated(slc)) allocate(slc(1:Atm_block%nblks,maxblk,lsoil)) + if (.not. allocated(stc)) allocate(stc(1:Atm_block%nblks,maxblk,lsoil)) + if (.not. allocated(stype)) allocate(stype(1:Atm_block%nblks,maxblk)) + if (.not. allocated(vfrac)) allocate(vfrac(1:Atm_block%nblks,maxblk)) + if (.not. allocated(snoalb)) allocate(snoalb(1:Atm_block%nblks,maxblk)) + if (.not. allocated(alvsf)) allocate(alvsf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(alnsf)) allocate(alnsf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(alvwf)) allocate(alvwf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(alnwf)) allocate(alnwf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(facsf)) allocate(facsf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(facwf)) allocate(facwf(1:Atm_block%nblks,maxblk)) + if (.not. allocated(semis)) allocate(semis(1:Atm_block%nblks,maxblk)) + if (.not. allocated(zorll)) allocate(zorll(1:Atm_block%nblks,maxblk)) endif if ( GFS_Control%lndp_type .EQ. 1 ) then ! this scheme sets perts once - allocate(sfc_wts(1:Atm_block%nblks,maxval(GFS_Control%blksz),GFS_Control%n_var_lndp)) - call run_stochastic_physics(GFS_Control%levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & + if (.not. allocated(sfc_wts)) allocate(sfc_wts(1:Atm_block%nblks, maxblk, GFS_Control%n_var_lndp)) + call run_stochastic_physics(levs, kdt_loc, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) ! Copy contiguous data back @@ -161,7 +165,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if(GFS_Control%do_ca)then ! DH* The current implementation of cellular_automata assumes that all blocksizes are the ! same - abort if this is not the case, otherwise proceed with Atm_block%blksz(1) below - if (.not. minval(Atm_block%blksz)==maxval(Atm_block%blksz)) then + if (.not. minval(Atm_block%blksz) == maxblk) then call mpp_error(FATAL, 'Logic errror: cellular_automata not compatible with non-uniform blocksizes') end if ! *DH @@ -169,7 +173,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) else initalize_stochastic_physics if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .EQ. 2) ) then - call run_stochastic_physics(GFS_Control%levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & + call run_stochastic_physics(levs, kdt_loc, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) ! Copy contiguous data back @@ -232,7 +236,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif call lndp_apply_perts(GFS_Control%blksz, GFS_Control%lsm, GFS_Control%lsm_noah, GFS_Control%lsm_ruc, lsoil, & - GFS_Control%dtf, GFS_Control%kdt, GFS_Control%lndp_each_step, & + GFS_Control%dtf, kdt_loc, GFS_Control%lndp_each_step, & GFS_Control%n_var_lndp, GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & sfc_wts, xlon, xlat, stype, GFS_Control%pores, GFS_Control%resid,param_update_flag, & smc, slc, stc, vfrac, alvsf, alnsf, alvwf, alnwf, facsf, facwf, snoalb, semis, zorll, ierr) @@ -275,7 +279,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif initalize_stochastic_physics if(GFS_Control%do_ca)then - if (GFS_Control%kdt==0) then + if (kdt_loc == 0) then do nb=1,Atm_block%nblks GFS_Data(nb)%Intdiag%ca_deep(:) = 0. @@ -296,16 +300,16 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if(GFS_Control%ca_sgs)then ! Allocate contiguous arrays; copy in as needed - allocate(sst (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(lmsk (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(lake (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_deep_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_turb_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_shal_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(condition (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_deep_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_turb_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) - allocate(ca_shal_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz) )) + if (.not. allocated(sst)) allocate(sst (1:Atm_block%nblks, maxblk)) + if (.not. allocated(lmsk)) allocate(lmsk (1:Atm_block%nblks, maxblk)) + if (.not. allocated(lake)) allocate(lake (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_deep_diag)) allocate(ca_deep_diag(1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_turb_diag)) allocate(ca_turb_diag(1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_shal_diag)) allocate(ca_shal_diag(1:Atm_block%nblks, maxblk)) + if (.not. allocated(condition)) allocate(condition (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_deep_cpl)) allocate(ca_deep_cpl (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_turb_cpl)) allocate(ca_turb_cpl (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca_shal_cpl)) allocate(ca_shal_cpl (1:Atm_block%nblks, maxblk)) do nb=1,Atm_block%nblks sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) @@ -315,10 +319,10 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) enddo - call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & - sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & - ca_shal_diag,Atm(mygrid)%domain_for_coupler,Atm_block%nblks, & - Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, GFS_Control%levs, & + call cellular_automata_sgs(kdt_loc,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & + sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & + ca_shal_diag,Atm(mygrid)%domain_for_coupler,Atm_block%nblks, & + Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives,GFS_Control%nfracseed, & GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & GFS_Control%ca_smooth,GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) @@ -344,15 +348,15 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif if(GFS_Control%ca_global)then ! Allocate contiguous arrays; no need to copy in (intent out) - allocate(ca1_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(ca2_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(ca3_cpl (1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(ca1_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(ca2_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - allocate(ca3_diag(1:Atm_block%nblks,maxval(GFS_Control%blksz))) - call cellular_automata_global(GFS_Control%kdt,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & + if (.not. allocated(ca1_cpl)) allocate(ca1_cpl (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca2_cpl)) allocate(ca2_cpl (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca3_cpl)) allocate(ca3_cpl (1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca1_diag)) allocate(ca1_diag(1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca2_cpl)) allocate(ca2_diag(1:Atm_block%nblks, maxblk)) + if (.not. allocated(ca3_diag)) allocate(ca3_diag(1:Atm_block%nblks, maxblk)) + call cellular_automata_global(kdt_loc,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & Atm(mygrid)%domain_for_coupler, & - Atm_block%nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,GFS_Control%levs, & + Atm_block%nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,levs, & GFS_Control%nca_g,GFS_Control%ncells_g,GFS_Control%nlives_g,GFS_Control%nfracseed,GFS_Control%nseed_g, & GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca,GFS_Control%ca_smooth,GFS_Control%nspinup,Atm_block%blksz(1), & GFS_Control%nsmooth,GFS_Control%ca_amplitude,GFS_Control%master,GFS_Control%communicator) @@ -373,7 +377,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) deallocate(ca3_diag) endif - endif !kdt =0 + endif !kdt_loc = 0 endif !do_ca From aecb03aa4b0ae4f46ef7e6393d93a55e5a61121a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 23 Jun 2021 13:05:53 -0400 Subject: [PATCH 162/217] removing .not. allocated from stochastic_wrapper --- .../stochastic_physics_wrapper.F90 | 76 +++++++++---------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 7e6f48ffe..6b9e135b6 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -97,8 +97,8 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) initalize_stochastic_physics: if (kdt_loc == 0) then if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then - if (.not. allocated(xlat)) allocate(xlat(1:Atm_block%nblks,maxblk)) - if (.not. allocated(xlon)) allocate(xlon(1:Atm_block%nblks,maxblk)) + allocate(xlat(1:Atm_block%nblks,maxblk)) + allocate(xlon(1:Atm_block%nblks,maxblk)) do nb=1,Atm_block%nblks xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) @@ -115,17 +115,17 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif end if if (GFS_Control%do_sppt) then - if (.not. allocated(sppt_wts)) allocate(sppt_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(sppt_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if (GFS_Control%do_shum) then - if (.not. allocated(shum_wts)) allocate(shum_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(shum_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if (GFS_Control%do_skeb) then - if (.not. allocated(skebu_wts)) allocate(skebu_wts(1:Atm_block%nblks,maxblk,1:levs)) - if (.not. allocated(skebv_wts)) allocate(skebv_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(skebu_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(skebv_wts(1:Atm_block%nblks,maxblk,1:levs)) end if if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast - if (.not. allocated(sfc_wts)) allocate(sfc_wts(1:Atm_block%nblks,maxblk,1:GFS_Control%n_var_lndp)) + allocate(sfc_wts(1:Atm_block%nblks,maxblk,1:GFS_Control%n_var_lndp)) end if if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme if (GFS_Control%lsm == GFS_Control%lsm_noah) then @@ -133,25 +133,25 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then lsoil = GFS_Control%lsoil_lsm endif - if (.not. allocated(smc)) allocate(smc(1:Atm_block%nblks,maxblk,lsoil)) - if (.not. allocated(slc)) allocate(slc(1:Atm_block%nblks,maxblk,lsoil)) - if (.not. allocated(stc)) allocate(stc(1:Atm_block%nblks,maxblk,lsoil)) - if (.not. allocated(stype)) allocate(stype(1:Atm_block%nblks,maxblk)) - if (.not. allocated(vfrac)) allocate(vfrac(1:Atm_block%nblks,maxblk)) - if (.not. allocated(snoalb)) allocate(snoalb(1:Atm_block%nblks,maxblk)) - if (.not. allocated(alvsf)) allocate(alvsf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(alnsf)) allocate(alnsf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(alvwf)) allocate(alvwf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(alnwf)) allocate(alnwf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(facsf)) allocate(facsf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(facwf)) allocate(facwf(1:Atm_block%nblks,maxblk)) - if (.not. allocated(semis)) allocate(semis(1:Atm_block%nblks,maxblk)) - if (.not. allocated(zorll)) allocate(zorll(1:Atm_block%nblks,maxblk)) + allocate(smc(1:Atm_block%nblks,maxblk,lsoil)) + allocate(slc(1:Atm_block%nblks,maxblk,lsoil)) + allocate(stc(1:Atm_block%nblks,maxblk,lsoil)) + allocate(stype(1:Atm_block%nblks,maxblk)) + allocate(vfrac(1:Atm_block%nblks,maxblk)) + allocate(snoalb(1:Atm_block%nblks,maxblk)) + allocate(alvsf(1:Atm_block%nblks,maxblk)) + allocate(alnsf(1:Atm_block%nblks,maxblk)) + allocate(alvwf(1:Atm_block%nblks,maxblk)) + allocate(alnwf(1:Atm_block%nblks,maxblk)) + allocate(facsf(1:Atm_block%nblks,maxblk)) + allocate(facwf(1:Atm_block%nblks,maxblk)) + allocate(semis(1:Atm_block%nblks,maxblk)) + allocate(zorll(1:Atm_block%nblks,maxblk)) endif if ( GFS_Control%lndp_type .EQ. 1 ) then ! this scheme sets perts once - if (.not. allocated(sfc_wts)) allocate(sfc_wts(1:Atm_block%nblks, maxblk, GFS_Control%n_var_lndp)) + allocate(sfc_wts(1:Atm_block%nblks, maxblk, GFS_Control%n_var_lndp)) call run_stochastic_physics(levs, kdt_loc, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) @@ -300,16 +300,16 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if(GFS_Control%ca_sgs)then ! Allocate contiguous arrays; copy in as needed - if (.not. allocated(sst)) allocate(sst (1:Atm_block%nblks, maxblk)) - if (.not. allocated(lmsk)) allocate(lmsk (1:Atm_block%nblks, maxblk)) - if (.not. allocated(lake)) allocate(lake (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_deep_diag)) allocate(ca_deep_diag(1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_turb_diag)) allocate(ca_turb_diag(1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_shal_diag)) allocate(ca_shal_diag(1:Atm_block%nblks, maxblk)) - if (.not. allocated(condition)) allocate(condition (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_deep_cpl)) allocate(ca_deep_cpl (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_turb_cpl)) allocate(ca_turb_cpl (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca_shal_cpl)) allocate(ca_shal_cpl (1:Atm_block%nblks, maxblk)) + allocate(sst (1:Atm_block%nblks, maxblk)) + allocate(lmsk (1:Atm_block%nblks, maxblk)) + allocate(lake (1:Atm_block%nblks, maxblk)) + allocate(ca_deep_diag(1:Atm_block%nblks, maxblk)) + allocate(ca_turb_diag(1:Atm_block%nblks, maxblk)) + allocate(ca_shal_diag(1:Atm_block%nblks, maxblk)) + allocate(condition (1:Atm_block%nblks, maxblk)) + allocate(ca_deep_cpl (1:Atm_block%nblks, maxblk)) + allocate(ca_turb_cpl (1:Atm_block%nblks, maxblk)) + allocate(ca_shal_cpl (1:Atm_block%nblks, maxblk)) do nb=1,Atm_block%nblks sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) @@ -348,12 +348,12 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif if(GFS_Control%ca_global)then ! Allocate contiguous arrays; no need to copy in (intent out) - if (.not. allocated(ca1_cpl)) allocate(ca1_cpl (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca2_cpl)) allocate(ca2_cpl (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca3_cpl)) allocate(ca3_cpl (1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca1_diag)) allocate(ca1_diag(1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca2_cpl)) allocate(ca2_diag(1:Atm_block%nblks, maxblk)) - if (.not. allocated(ca3_diag)) allocate(ca3_diag(1:Atm_block%nblks, maxblk)) + allocate(ca1_cpl (1:Atm_block%nblks, maxblk)) + allocate(ca2_cpl (1:Atm_block%nblks, maxblk)) + allocate(ca3_cpl (1:Atm_block%nblks, maxblk)) + allocate(ca1_diag(1:Atm_block%nblks, maxblk)) + allocate(ca2_diag(1:Atm_block%nblks, maxblk)) + allocate(ca3_diag(1:Atm_block%nblks, maxblk)) call cellular_automata_global(kdt_loc,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & Atm(mygrid)%domain_for_coupler, & Atm_block%nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,levs, & From 4d9842af654bde64f85e3c2f642cfa40dc4b2f1f Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 24 Jun 2021 21:01:19 -0400 Subject: [PATCH 163/217] fixing stochastic wrapper related issues --- atmos_model.F90 | 9 +- ccpp/data/GFS_typedefs.F90 | 7 +- .../stochastic_physics_wrapper.F90 | 266 +++++++++--------- 3 files changed, 139 insertions(+), 143 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 838335c6e..03a673ee2 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -261,8 +261,8 @@ subroutine update_atmos_radiation_physics (Atmos) call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') - if ((GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & - GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca) .and. GFS_Control%kdt > GFS_Control%kdt_start) then + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & + GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then !--- call stochastic physics pattern generation / cellular automata call stochastic_physics_wrapper(GFS_control, GFS_data, Atm_block, ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') @@ -270,7 +270,8 @@ subroutine update_atmos_radiation_physics (Atmos) !--- if coupled, assign coupled fields - if (.not. GFS_control%cplchm) then +! if (.not. GFS_control%cplchm) then + if (GFS_control%cplflx .or. GFS_control%cplwav2atm) then call assign_importdata(rc) endif @@ -825,7 +826,7 @@ subroutine update_atmos_model_state (Atmos) if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs' call atmosphere_nggps_diag(Atmos%Time) call FV3GFS_diag_output(Atmos%Time, GFS_Diag, Atm_block, GFS_control%nx, GFS_control%ny, & - GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & + GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & GFS_control%fhswr, GFS_control%fhlwr) if (nint(GFS_control%fhzero) > 0) then if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index ea53e7922..06b818795 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1191,7 +1191,6 @@ module GFS_typedefs real(kind=kind_phys) :: fhour !< current forecast hour real(kind=kind_phys) :: zhour !< previous hour diagnostic buckets emptied integer :: kdt !< current forecast iteration - integer :: kdt_start !< current forecast iteration logical :: first_time_step !< flag signaling first time step for time integration routine logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) logical :: hydrostatic !< flag whether this is a hydrostatic or non-hydrostatic run @@ -3330,11 +3329,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< (used if mstrat=.true.) real(kind=kind_phys) :: crtrh(3) = (/0.90d0,0.90d0,0.90d0/) !< critical relative humidity at the surface !< PBL top and at the top of the atmosphere - real(kind=kind_phys) :: dlqf(2) = (/0.0d0,0.0d0/) !< factor for cloud condensate detrainment + real(kind=kind_phys) :: dlqf(2) = (/0.15,0.15/) !< factor for cloud condensate detrainment !< from cloud edges for RAS 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 + real(kind=kind_phys) :: wminras(2) = (/1.0d-6,1.0d-6/) !< [in] water and ice minimum threshold for ras integer :: nrcmax = 32 !< number of random numbers used in RAS real(kind=kind_phys) :: rbcr = 0.25 !< Critical Richardson Number in PBL scheme @@ -4444,7 +4443,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) Model%kdt = nint(Model%fhour*con_hr/Model%dtp) - Model%kdt_start = Model%kdt Model%first_time_step = .true. Model%restart = restart Model%hydrostatic = hydrostatic @@ -5405,7 +5403,6 @@ subroutine control_print(Model) print *, ' fhour : ', Model%fhour print *, ' zhour : ', Model%zhour print *, ' kdt : ', Model%kdt - print *, ' kdt_start : ', Model%kdt_start print *, ' jdat : ', Model%jdat print *, ' si : ', Model%si print *, ' sec : ', Model%sec diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 6b9e135b6..bfe0ad874 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -13,26 +13,27 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:,:), allocatable, save :: skebv_wts real(kind=kind_phys), dimension(:,:,:), allocatable, save :: sfc_wts + logical, save :: is_initialized = .false. integer, save :: lsoil = -999 real(kind=kind_phys), dimension(:,:,:), allocatable, save :: smc real(kind=kind_phys), dimension(:,:,:), allocatable, save :: stc real(kind=kind_phys), dimension(:,:,:), allocatable, save :: slc ! - real(kind=kind_phys), dimension(:,:), allocatable, save :: vfrac + real(kind=kind_phys), dimension(:,:), allocatable, save :: vfrac !albedo - real(kind=kind_phys), dimension(:,:), allocatable, save :: snoalb - real(kind=kind_phys), dimension(:,:), allocatable, save :: alvsf - real(kind=kind_phys), dimension(:,:), allocatable, save :: alnsf - real(kind=kind_phys), dimension(:,:), allocatable, save :: alvwf - real(kind=kind_phys), dimension(:,:), allocatable, save :: alnwf - real(kind=kind_phys), dimension(:,:), allocatable, save :: facsf - real(kind=kind_phys), dimension(:,:), allocatable, save :: facwf + real(kind=kind_phys), dimension(:,:), allocatable, save :: snoalb + real(kind=kind_phys), dimension(:,:), allocatable, save :: alvsf + real(kind=kind_phys), dimension(:,:), allocatable, save :: alnsf + real(kind=kind_phys), dimension(:,:), allocatable, save :: alvwf + real(kind=kind_phys), dimension(:,:), allocatable, save :: alnwf + real(kind=kind_phys), dimension(:,:), allocatable, save :: facsf + real(kind=kind_phys), dimension(:,:), allocatable, save :: facwf !emissivity - real(kind=kind_phys), dimension(:,:), allocatable, save :: semis + real(kind=kind_phys), dimension(:,:), allocatable, save :: semis !roughness length for land - real(kind=kind_phys), dimension(:,:), allocatable, save :: zorll + real(kind=kind_phys), dimension(:,:), allocatable, save :: zorll - real(kind=kind_phys), dimension(:,:), allocatable, save :: stype + real(kind=kind_phys), dimension(:,:), allocatable, save :: stype ! For cellular automata real(kind=kind_phys), dimension(:,:), allocatable, save :: sst @@ -70,7 +71,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) use stochastic_physics, only: init_stochastic_physics, run_stochastic_physics use cellular_automata_global_mod, only: cellular_automata_global use cellular_automata_sgs_mod, only: cellular_automata_sgs - use lndp_apply_perts_mod, only: lndp_apply_perts + use lndp_apply_perts_mod, only: lndp_apply_perts implicit none @@ -79,7 +80,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) type(block_control_type), intent(inout) :: Atm_block integer, intent(out) :: ierr - integer :: nthreads, nb, levs, maxblk, kdt_loc + integer :: nthreads, nb, levs, maxblk, nblks logical :: param_update_flag #ifdef _OPENMP @@ -91,22 +92,23 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) levs = GFS_Control%levs maxblk = maxval(GFS_Control%blksz) - kdt_loc = GFS_Control%kdt - GFS_Control%kdt_start + nblks = Atm_block%nblks + ! Initialize - initalize_stochastic_physics: if (kdt_loc == 0) then + initalize_stochastic_physics: if (.not. is_initialized) then if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then - allocate(xlat(1:Atm_block%nblks,maxblk)) - allocate(xlon(1:Atm_block%nblks,maxblk)) - do nb=1,Atm_block%nblks + allocate(xlat(1:nblks,maxblk)) + allocate(xlon(1:nblks,maxblk)) + do nb=1,nblks xlat(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlat(:) xlon(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Grid%xlon(:) end do ! Initialize stochastic physics - call init_stochastic_physics(levs, GFS_Control%blksz, GFS_Control%dtp, GFS_Control%sppt_amp, & - GFS_Control%input_nml_file, GFS_Control%fn_nml, GFS_Control%nlunit, xlon, xlat, GFS_Control%do_sppt, GFS_Control%do_shum, & - GFS_Control%do_skeb, GFS_Control%lndp_type, GFS_Control%n_var_lndp, GFS_Control%use_zmtnblck, GFS_Control%skeb_npass, & + call init_stochastic_physics(levs, GFS_Control%blksz, GFS_Control%dtp, GFS_Control%sppt_amp, & + GFS_Control%input_nml_file, GFS_Control%fn_nml, GFS_Control%nlunit, xlon, xlat, GFS_Control%do_sppt, GFS_Control%do_shum, & + GFS_Control%do_skeb, GFS_Control%lndp_type, GFS_Control%n_var_lndp, GFS_Control%use_zmtnblck, GFS_Control%skeb_npass, & GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & GFS_Control%ak, GFS_Control%bk, nthreads, GFS_Control%master, GFS_Control%communicator, ierr) if (ierr/=0) then @@ -115,48 +117,48 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif end if if (GFS_Control%do_sppt) then - allocate(sppt_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(sppt_wts(1:nblks,maxblk,1:levs)) end if if (GFS_Control%do_shum) then - allocate(shum_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(shum_wts(1:nblks,maxblk,1:levs)) end if if (GFS_Control%do_skeb) then - allocate(skebu_wts(1:Atm_block%nblks,maxblk,1:levs)) - allocate(skebv_wts(1:Atm_block%nblks,maxblk,1:levs)) + allocate(skebu_wts(1:nblks,maxblk,1:levs)) + allocate(skebv_wts(1:nblks,maxblk,1:levs)) end if - if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast - allocate(sfc_wts(1:Atm_block%nblks,maxblk,1:GFS_Control%n_var_lndp)) + if ( GFS_Control%lndp_type == 2 ) then ! this scheme updates through forecast + allocate(sfc_wts(1:nblks,maxblk,1:GFS_Control%n_var_lndp)) end if - if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme + if (GFS_Control%lndp_type == 2) then ! save wts, and apply lndp scheme if (GFS_Control%lsm == GFS_Control%lsm_noah) then lsoil = GFS_Control%lsoil elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then lsoil = GFS_Control%lsoil_lsm endif - allocate(smc(1:Atm_block%nblks,maxblk,lsoil)) - allocate(slc(1:Atm_block%nblks,maxblk,lsoil)) - allocate(stc(1:Atm_block%nblks,maxblk,lsoil)) - allocate(stype(1:Atm_block%nblks,maxblk)) - allocate(vfrac(1:Atm_block%nblks,maxblk)) - allocate(snoalb(1:Atm_block%nblks,maxblk)) - allocate(alvsf(1:Atm_block%nblks,maxblk)) - allocate(alnsf(1:Atm_block%nblks,maxblk)) - allocate(alvwf(1:Atm_block%nblks,maxblk)) - allocate(alnwf(1:Atm_block%nblks,maxblk)) - allocate(facsf(1:Atm_block%nblks,maxblk)) - allocate(facwf(1:Atm_block%nblks,maxblk)) - allocate(semis(1:Atm_block%nblks,maxblk)) - allocate(zorll(1:Atm_block%nblks,maxblk)) + allocate(smc (1:nblks, maxblk, lsoil)) + allocate(slc (1:nblks, maxblk, lsoil)) + allocate(stc (1:nblks, maxblk, lsoil)) + allocate(stype (1:nblks, maxblk)) + allocate(vfrac (1:nblks, maxblk)) + allocate(snoalb(1:nblks, maxblk)) + allocate(alvsf (1:nblks, maxblk)) + allocate(alnsf (1:nblks, maxblk)) + allocate(alvwf (1:nblks, maxblk)) + allocate(alnwf (1:nblks, maxblk)) + allocate(facsf (1:nblks, maxblk)) + allocate(facwf (1:nblks, maxblk)) + allocate(semis (1:nblks, maxblk)) + allocate(zorll (1:nblks, maxblk)) endif - if ( GFS_Control%lndp_type .EQ. 1 ) then ! this scheme sets perts once - allocate(sfc_wts(1:Atm_block%nblks, maxblk, GFS_Control%n_var_lndp)) - call run_stochastic_physics(levs, kdt_loc, GFS_Control%fhour, GFS_Control%blksz, & - sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & - nthreads=nthreads) + if ( GFS_Control%lndp_type == 1 ) then ! this scheme sets perts once + allocate(sfc_wts(1:nblks, maxblk, GFS_Control%n_var_lndp)) + call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & + sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, & + skebv_wts=skebv_wts, sfc_wts=sfc_wts, nthreads=nthreads) ! Copy contiguous data back - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) end do deallocate(sfc_wts) @@ -169,36 +171,52 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) call mpp_error(FATAL, 'Logic errror: cellular_automata not compatible with non-uniform blocksizes') end if ! *DH + do nb=1,nblks + GFS_Data(nb)%Intdiag%ca_deep(:) = 0. + GFS_Data(nb)%Intdiag%ca_turb(:) = 0. + GFS_Data(nb)%Intdiag%ca_shal(:) = 0. + GFS_Data(nb)%Coupling%ca_deep(:) = 0. + GFS_Data(nb)%Coupling%ca_turb(:) = 0. + GFS_Data(nb)%Coupling%ca_shal(:) = 0. + GFS_Data(nb)%Coupling%ca1(:) = 0. + GFS_Data(nb)%Coupling%ca2(:) = 0. + GFS_Data(nb)%Coupling%ca3(:) = 0. + GFS_Data(nb)%Intdiag%ca1(:) = 0. + GFS_Data(nb)%Intdiag%ca2(:) = 0. + GFS_Data(nb)%Intdiag%ca3(:) = 0. + enddo endif + is_initialized = .true. + else initalize_stochastic_physics - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .EQ. 2) ) then - call run_stochastic_physics(levs, kdt_loc, GFS_Control%fhour, GFS_Control%blksz, & + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type == 2) ) then + call run_stochastic_physics(levs, GFS_Control%kdt, GFS_Control%fhour, GFS_Control%blksz, & sppt_wts=sppt_wts, shum_wts=shum_wts, skebu_wts=skebu_wts, skebv_wts=skebv_wts, sfc_wts=sfc_wts, & nthreads=nthreads) ! Copy contiguous data back if (GFS_Control%do_sppt) then - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Coupling%sppt_wts(:,:) = sppt_wts(nb,1:GFS_Control%blksz(nb),:) end do end if if (GFS_Control%do_shum) then - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Coupling%shum_wts(:,:) = shum_wts(nb,1:GFS_Control%blksz(nb),:) end do end if if (GFS_Control%do_skeb) then - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Coupling%skebu_wts(:,:) = skebu_wts(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Coupling%skebv_wts(:,:) = skebv_wts(nb,1:GFS_Control%blksz(nb),:) end do end if - if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme - do nb=1,Atm_block%nblks + if (GFS_Control%lndp_type == 2) then ! save wts, and apply lndp scheme + do nb=1,nblks GFS_Data(nb)%Coupling%sfc_wts(:,:) = sfc_wts(nb,1:GFS_Control%blksz(nb),:) end do - do nb=1,Atm_block%nblks + do nb=1,nblks stype(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%stype(:) vfrac(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%vfrac(:) snoalb(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%snoalb(:) @@ -213,13 +231,13 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) end do if (GFS_Control%lsm == GFS_Control%lsm_noah) then - do nb=1,Atm_block%nblks + do nb=1,nblks smc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%smc(:,:) slc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%slc(:,:) stc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%stc(:,:) end do elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then - do nb=1,Atm_block%nblks + do nb=1,nblks smc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%smois(:,:) slc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%sh2o(:,:) stc(nb,1:GFS_Control%blksz(nb),:) = GFS_Data(nb)%Sfcprop%tslb(:,:) @@ -236,7 +254,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif call lndp_apply_perts(GFS_Control%blksz, GFS_Control%lsm, GFS_Control%lsm_noah, GFS_Control%lsm_ruc, lsoil, & - GFS_Control%dtf, kdt_loc, GFS_Control%lndp_each_step, & + GFS_Control%dtf, GFS_Control%kdt, GFS_Control%lndp_each_step, & GFS_Control%n_var_lndp, GFS_Control%lndp_var_list, GFS_Control%lndp_prt_list, & sfc_wts, xlon, xlat, stype, GFS_Control%pores, GFS_Control%resid,param_update_flag, & smc, slc, stc, vfrac, alvsf, alnsf, alvwf, alnwf, facsf, facwf, snoalb, semis, zorll, ierr) @@ -246,7 +264,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) return endif - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Sfcprop%vfrac(:) = vfrac(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Sfcprop%snoalb(:) = snoalb(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Sfcprop%alvsf(:) = alvsf(nb,1:GFS_Control%blksz(nb)) @@ -260,13 +278,13 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) enddo if (GFS_Control%lsm == GFS_Control%lsm_noah) then - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Sfcprop%smc(:,:) = smc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%slc(:,:) = slc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%stc(:,:) = stc(nb,1:GFS_Control%blksz(nb),:) enddo elseif (GFS_Control%lsm == GFS_Control%lsm_ruc) then - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Sfcprop%smois(:,:) = smc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%sh2o(:,:) = slc(nb,1:GFS_Control%blksz(nb),:) GFS_Data(nb)%Sfcprop%tslb(:,:) = stc(nb,1:GFS_Control%blksz(nb),:) @@ -278,56 +296,38 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif initalize_stochastic_physics - if(GFS_Control%do_ca)then - if (kdt_loc == 0) then - - do nb=1,Atm_block%nblks - GFS_Data(nb)%Intdiag%ca_deep(:) = 0. - GFS_Data(nb)%Intdiag%ca_turb(:) = 0. - GFS_Data(nb)%Intdiag%ca_shal(:) = 0. - GFS_Data(nb)%Coupling%ca_deep(:) = 0. - GFS_Data(nb)%Coupling%ca_turb(:) = 0. - GFS_Data(nb)%Coupling%ca_shal(:) = 0. - GFS_Data(nb)%Coupling%ca1(:) = 0. - GFS_Data(nb)%Coupling%ca2(:) = 0. - GFS_Data(nb)%Coupling%ca3(:) = 0. - GFS_Data(nb)%Intdiag%ca1(:) = 0. - GFS_Data(nb)%Intdiag%ca2(:) = 0. - GFS_Data(nb)%Intdiag%ca3(:) = 0. - enddo - - else + if (GFS_Control%do_ca .and. is_initialized) then if(GFS_Control%ca_sgs)then ! Allocate contiguous arrays; copy in as needed - allocate(sst (1:Atm_block%nblks, maxblk)) - allocate(lmsk (1:Atm_block%nblks, maxblk)) - allocate(lake (1:Atm_block%nblks, maxblk)) - allocate(ca_deep_diag(1:Atm_block%nblks, maxblk)) - allocate(ca_turb_diag(1:Atm_block%nblks, maxblk)) - allocate(ca_shal_diag(1:Atm_block%nblks, maxblk)) - allocate(condition (1:Atm_block%nblks, maxblk)) - allocate(ca_deep_cpl (1:Atm_block%nblks, maxblk)) - allocate(ca_turb_cpl (1:Atm_block%nblks, maxblk)) - allocate(ca_shal_cpl (1:Atm_block%nblks, maxblk)) - do nb=1,Atm_block%nblks - sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) - lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) - lake (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%lakefrac(:) - condition (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%condition(:) - ca_deep_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_deep(:) - ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) - ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) + allocate(sst (1:nblks, maxblk)) + allocate(lmsk (1:nblks, maxblk)) + allocate(lake (1:nblks, maxblk)) + allocate(ca_deep_diag(1:nblks, maxblk)) + allocate(ca_turb_diag(1:nblks, maxblk)) + allocate(ca_shal_diag(1:nblks, maxblk)) + allocate(condition (1:nblks, maxblk)) + allocate(ca_deep_cpl (1:nblks, maxblk)) + allocate(ca_turb_cpl (1:nblks, maxblk)) + allocate(ca_shal_cpl (1:nblks, maxblk)) + do nb=1,nblks + sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) + lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) + lake (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%lakefrac(:) + condition (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%condition(:) + ca_deep_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_deep(:) + ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) + ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) enddo - call cellular_automata_sgs(kdt_loc,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & - sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & - ca_shal_diag,Atm(mygrid)%domain_for_coupler,Atm_block%nblks, & - Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & + call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & + sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & + ca_shal_diag,Atm(mygrid)%domain_for_coupler,nblks, & + Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives,GFS_Control%nfracseed, & - GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & + GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & GFS_Control%ca_smooth,GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back as needed - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Intdiag%ca_deep(:) = ca_deep_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Intdiag%ca_turb(:) = ca_turb_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Intdiag%ca_shal(:) = ca_shal_diag(nb,1:GFS_Control%blksz(nb)) @@ -348,20 +348,19 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) endif if(GFS_Control%ca_global)then ! Allocate contiguous arrays; no need to copy in (intent out) - allocate(ca1_cpl (1:Atm_block%nblks, maxblk)) - allocate(ca2_cpl (1:Atm_block%nblks, maxblk)) - allocate(ca3_cpl (1:Atm_block%nblks, maxblk)) - allocate(ca1_diag(1:Atm_block%nblks, maxblk)) - allocate(ca2_diag(1:Atm_block%nblks, maxblk)) - allocate(ca3_diag(1:Atm_block%nblks, maxblk)) - call cellular_automata_global(kdt_loc,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & - Atm(mygrid)%domain_for_coupler, & - Atm_block%nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,levs, & - GFS_Control%nca_g,GFS_Control%ncells_g,GFS_Control%nlives_g,GFS_Control%nfracseed,GFS_Control%nseed_g, & - GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca,GFS_Control%ca_smooth,GFS_Control%nspinup,Atm_block%blksz(1), & + allocate(ca1_cpl (1:nblks, maxblk)) + allocate(ca2_cpl (1:nblks, maxblk)) + allocate(ca3_cpl (1:nblks, maxblk)) + allocate(ca1_diag(1:nblks, maxblk)) + allocate(ca2_diag(1:nblks, maxblk)) + allocate(ca3_diag(1:nblks, maxblk)) + call cellular_automata_global(GFS_Control%kdt,GFS_Control%first_time_step,ca1_cpl,ca2_cpl,ca3_cpl,ca1_diag,ca2_diag,ca3_diag, & + Atm(mygrid)%domain_for_coupler, nblks,Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy,levs, & + GFS_Control%nca_g,GFS_Control%ncells_g,GFS_Control%nlives_g,GFS_Control%nfracseed,GFS_Control%nseed_g, & + GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca,GFS_Control%ca_smooth,GFS_Control%nspinup,Atm_block%blksz(1), & GFS_Control%nsmooth,GFS_Control%ca_amplitude,GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back - do nb=1,Atm_block%nblks + do nb=1,nblks GFS_Data(nb)%Coupling%ca1(:) = ca1_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca2(:) = ca2_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca3(:) = ca3_cpl (nb,1:GFS_Control%blksz(nb)) @@ -377,7 +376,6 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) deallocate(ca3_diag) endif - endif !kdt_loc = 0 endif !do_ca @@ -393,7 +391,7 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) type(GFS_control_type), intent(inout) :: GFS_Control - if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type .GT. 0) ) then + if (GFS_Control%do_sppt .OR. GFS_Control%do_shum .OR. GFS_Control%do_skeb .OR. (GFS_Control%lndp_type > 0) ) then if (allocated(xlat)) deallocate(xlat) if (allocated(xlon)) deallocate(xlon) if (GFS_Control%do_sppt) then @@ -406,25 +404,25 @@ subroutine stochastic_physics_wrapper_end (GFS_Control) if (allocated(skebu_wts)) deallocate(skebu_wts) if (allocated(skebv_wts)) deallocate(skebv_wts) end if - if ( GFS_Control%lndp_type .EQ. 2 ) then ! this scheme updates through forecast + if ( GFS_Control%lndp_type == 2 ) then ! this scheme updates through forecast lsoil = -999 if (allocated(sfc_wts)) deallocate(sfc_wts) end if - if (GFS_Control%lndp_type .EQ. 2) then ! save wts, and apply lndp scheme - if (allocated(smc)) deallocate(smc) - if (allocated(slc)) deallocate(slc) - if (allocated(stc)) deallocate(stc) - if (allocated(stype)) deallocate(stype) - if (allocated(vfrac)) deallocate(vfrac) + if (GFS_Control%lndp_type == 2) then ! save wts, and apply lndp scheme + if (allocated(smc)) deallocate(smc) + if (allocated(slc)) deallocate(slc) + if (allocated(stc)) deallocate(stc) + if (allocated(stype)) deallocate(stype) + if (allocated(vfrac)) deallocate(vfrac) if (allocated(snoalb)) deallocate(snoalb) - if (allocated(alvsf)) deallocate(alvsf) - if (allocated(alnsf)) deallocate(alnsf) - if (allocated(alvwf)) deallocate(alvwf) - if (allocated(alnwf)) deallocate(alnwf) - if (allocated(facsf)) deallocate(facsf) - if (allocated(facwf)) deallocate(facwf) - if (allocated(semis)) deallocate(semis) - if (allocated(zorll)) deallocate(zorll) + if (allocated(alvsf)) deallocate(alvsf) + if (allocated(alnsf)) deallocate(alnsf) + if (allocated(alvwf)) deallocate(alvwf) + if (allocated(alnwf)) deallocate(alnwf) + if (allocated(facsf)) deallocate(facsf) + if (allocated(facwf)) deallocate(facwf) + if (allocated(semis)) deallocate(semis) + if (allocated(zorll)) deallocate(zorll) endif call finalize_stochastic_physics() endif From 0ff82645b3c57ebbbd65e10552efc6f6a27bc654 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 29 Jun 2021 20:25:14 -0400 Subject: [PATCH 164/217] some fix to mask --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 26 ++++++++++++++------------ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 9cdc2b525..fe5f2fd31 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9cdc2b525083d8c4422ce4e861f3eb85866d863c +Subproject commit fe5f2fd31074a84486abc874d427330bca08f8cd diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 968289297..cebc5caa1 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1097,20 +1097,22 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%slmsk(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 - elseif (Sfcprop(nb)%landfrac(ix) > zero) then - Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = one else - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%slmsk(ix) = zero - if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + Sfcprop(nb)%slmsk(ix) = nint(Sfcprop(nb)%landfrac(ix)) + if (Sfcprop(nb)%stype(ix) <= 0) Sfcprop(nb)%slmsk(ix) = zero + if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then + Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 + else + Sfcprop(nb)%landfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero + endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then + if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero @@ -1133,7 +1135,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (warm_start) then Sfcprop(nb)%slmsk(ix) = sfc_var2(i,j,1) !--- slmsk endif - + ! !--- NSSTM variables if (Model%nstf_name(1) > 0) then From 552c1d57e57f730490e1dbb4a04e845077a1a3a9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 5 Jul 2021 21:02:39 -0400 Subject: [PATCH 165/217] updating to include CICE provided ice albedo --- atmos_model.F90 | 16 +++-- ccpp/data/GFS_typedefs.F90 | 75 +++++++++++-------- ccpp/data/GFS_typedefs.meta | 62 +++++----------- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 140 ++++++++++++++++++++++++++++-------- 5 files changed, 187 insertions(+), 108 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 9a9451ee5..818a2cf0c 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1895,7 +1895,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then - GFS_data(nb)%Coupling%sfc_alb_nir_dif_cpl(ix) = datar8(i,j) +! GFS_data(nb)%Coupling%sfc_alb_nir_dif_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%albdifnir_ice(ix) = datar8(i,j) endif enddo enddo @@ -1915,7 +1916,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then - GFS_data(nb)%Coupling%sfc_alb_nir_dir_cpl(ix) = datar8(i,j) +! GFS_data(nb)%Coupling%sfc_alb_nir_dir_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%albdirnir_ice(ix) = datar8(i,j) endif enddo enddo @@ -1935,7 +1937,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then - GFS_data(nb)%Coupling%sfc_alb_vis_dif_cpl(ix) = datar8(i,j) +! GFS_data(nb)%Coupling%sfc_alb_vis_dif_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%albdifvis_ice(ix) = datar8(i,j) endif enddo enddo @@ -1956,7 +1959,8 @@ subroutine assign_importdata(rc) nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero) then - GFS_data(nb)%Coupling%sfc_alb_vis_dir_cpl(ix) = datar8(i,j) +! GFS_data(nb)%Coupling%sfc_alb_vis_dir_cpl(ix) = datar8(i,j) + GFS_data(nb)%Sfcprop%albdirvis_ice(ix) = datar8(i,j) endif enddo enddo @@ -2377,6 +2381,10 @@ subroutine assign_importdata(rc) GFS_data(nb)%Coupling%dvsfcin_cpl(ix) = -99999.0 ! ,, GFS_data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! ,, GFS_data(nb)%Coupling%ulwsfcin_cpl(ix) = -99999.0 ! ,, + GFS_data(nb)%Sfcprop%albdirvis_ice(ix) = -9999.0 ! ,, + GFS_data(nb)%Sfcprop%albdirnir_ice(ix) = -9999.0 ! ,, + GFS_data(nb)%Sfcprop%albdifvis_ice(ix) = -9999.0 ! ,, + GFS_data(nb)%Sfcprop%albdifnir_ice(ix) = -9999.0 ! ,, if (abs(one-GFS_data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then ! 100% open water GFS_data(nb)%Coupling%slimskin_cpl(ix) = zero GFS_data(nb)%Sfcprop%slmsk(ix) = zero diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 09b23a386..3e04959de 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -329,10 +329,12 @@ module GFS_typedefs real (kind=kind_phys), pointer :: albdnir_lnd (:) => null() !< real (kind=kind_phys), pointer :: albivis_lnd (:) => null() !< real (kind=kind_phys), pointer :: albinir_lnd (:) => null() !< - real (kind=kind_phys), pointer :: albdvis_ice (:) => null() !< - real (kind=kind_phys), pointer :: albdnir_ice (:) => null() !< - real (kind=kind_phys), pointer :: albivis_ice (:) => null() !< - real (kind=kind_phys), pointer :: albinir_ice (:) => null() !< + + real (kind=kind_phys), pointer :: albdirvis_ice (:) => null() !< + real (kind=kind_phys), pointer :: albdifvis_ice (:) => null() !< + real (kind=kind_phys), pointer :: albdirnir_ice (:) => null() !< + real (kind=kind_phys), pointer :: albdifnir_ice (:) => null() !< +! real (kind=kind_phys), pointer :: sfalb_ice (:) => null() !< real (kind=kind_phys), pointer :: snicexy (:,:) => null() !< real (kind=kind_phys), pointer :: snliqxy (:,:) => null() !< @@ -454,10 +456,10 @@ 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) - real (kind=kind_phys), pointer :: sfc_alb_nir_dir_cpl(:) => null() !< sfc nir albedo for direct rad - real (kind=kind_phys), pointer :: sfc_alb_nir_dif_cpl(:) => null() !< sfc nir albedo for diffuse rad - real (kind=kind_phys), pointer :: sfc_alb_vis_dir_cpl(:) => null() !< sfc vis albedo for direct rad - real (kind=kind_phys), pointer :: sfc_alb_vis_dif_cpl(:) => null() !< sfc vis albedo for diffuse rad +! real (kind=kind_phys), pointer :: sfc_alb_nir_dir_cpl(:) => null() !< sfc nir albedo for direct rad +! real (kind=kind_phys), pointer :: sfc_alb_nir_dif_cpl(:) => null() !< sfc nir albedo for diffuse rad +! real (kind=kind_phys), pointer :: sfc_alb_vis_dir_cpl(:) => null() !< sfc vis albedo for direct rad +! real (kind=kind_phys), pointer :: sfc_alb_vis_dif_cpl(:) => null() !< sfc vis albedo for diffuse rad !--- 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 @@ -610,7 +612,7 @@ module GFS_typedefs logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection - + logical :: use_cice_alb !< default .true. if cplflx is .true. else .false. !--- integrated dynamics through earth's atmosphere logical :: lsidea @@ -2376,17 +2378,24 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%hice (IM)) allocate (Sfcprop%weasd (IM)) allocate (Sfcprop%sncovr (IM)) + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + allocate (Sfcprop%albdirvis_ice (IM)) + allocate (Sfcprop%albdifvis_ice (IM)) + allocate (Sfcprop%albdirnir_ice (IM)) + allocate (Sfcprop%albdifnir_ice (IM)) +! allocate (Sfcprop%sfalb_ice (IM)) + endif if (Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%sncovr_ice (IM)) allocate (Sfcprop%emis_ice (IM)) - allocate (Sfcprop%albdvis_ice (IM)) - allocate (Sfcprop%albdnir_ice (IM)) - allocate (Sfcprop%albivis_ice (IM)) - allocate (Sfcprop%albinir_ice (IM)) +! allocate (Sfcprop%albdvis_ice (IM)) +! allocate (Sfcprop%albdnir_ice (IM)) +! allocate (Sfcprop%albivis_ice (IM)) +! allocate (Sfcprop%albinir_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) - end if + endif allocate (Sfcprop%canopy (IM)) allocate (Sfcprop%ffmm (IM)) allocate (Sfcprop%ffhh (IM)) @@ -2400,17 +2409,24 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%hice = clear_val Sfcprop%weasd = clear_val Sfcprop%sncovr = clear_val + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + Sfcprop%albdirvis_ice = clear_val + Sfcprop%albdifvis_ice = clear_val + Sfcprop%albdirnir_ice = clear_val + Sfcprop%albdifnir_ice = clear_val +! Sfcprop%sfalb_ice = clear_val + endif if (Model%lsm == Model%lsm_ruc) then Sfcprop%sncovr_ice = clear_val Sfcprop%emis_ice = clear_val - Sfcprop%albdvis_ice = clear_val - Sfcprop%albdnir_ice = clear_val - Sfcprop%albivis_ice = clear_val - Sfcprop%albinir_ice = clear_val +! Sfcprop%albdvis_ice = clear_val +! Sfcprop%albdnir_ice = clear_val +! Sfcprop%albivis_ice = clear_val +! Sfcprop%albinir_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val - end if + endif Sfcprop%canopy = clear_val Sfcprop%ffmm = clear_val Sfcprop%ffhh = clear_val @@ -2762,10 +2778,10 @@ subroutine coupling_create (Coupling, IM, Model) ! allocate (Coupling%ficein_cpl (IM)) ! allocate (Coupling%hicein_cpl (IM)) allocate (Coupling%hsnoin_cpl (IM)) - allocate (Coupling%sfc_alb_nir_dir_cpl (IM)) - allocate (Coupling%sfc_alb_nir_dif_cpl (IM)) - allocate (Coupling%sfc_alb_vis_dir_cpl (IM)) - allocate (Coupling%sfc_alb_vis_dif_cpl (IM)) +! allocate (Coupling%sfc_alb_nir_dir_cpl (IM)) +! allocate (Coupling%sfc_alb_nir_dif_cpl (IM)) +! allocate (Coupling%sfc_alb_vis_dir_cpl (IM)) +! allocate (Coupling%sfc_alb_vis_dif_cpl (IM)) Coupling%slimskin_cpl = clear_val Coupling%dusfcin_cpl = clear_val @@ -2778,10 +2794,10 @@ subroutine coupling_create (Coupling, IM, Model) ! Coupling%ficein_cpl = clear_val ! Coupling%hicein_cpl = clear_val Coupling%hsnoin_cpl = clear_val - Coupling%sfc_alb_nir_dir_cpl = clear_val - Coupling%sfc_alb_nir_dif_cpl = clear_val - Coupling%sfc_alb_vis_dir_cpl = clear_val - Coupling%sfc_alb_vis_dif_cpl = clear_val +! Coupling%sfc_alb_nir_dir_cpl = clear_val +! Coupling%sfc_alb_nir_dif_cpl = clear_val +! Coupling%sfc_alb_vis_dir_cpl = clear_val +! Coupling%sfc_alb_vis_dif_cpl = clear_val !--- accumulated quantities allocate (Coupling%dusfc_cpl (IM)) @@ -3029,6 +3045,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplchm = .false. !< default no cplchm collection + logical :: use_cice_alb = .false. !< default no cice albedo !--- integrated dynamics through earth's atmosphere logical :: lsidea = .false. @@ -3480,7 +3497,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplwav, cplwav2atm, cplchm, lsidea, & + cplflx, cplwav, cplwav2atm, cplchm, use_cice_alb, lsidea, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, iaerclm, iflip, isol, ico2, ialb, & isot, iems, iaer, icliq_sw, iovr, ictm, isubc_sw, & @@ -3753,6 +3770,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm + Model%use_cice_alb = use_cice_alb !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea @@ -5072,6 +5090,7 @@ subroutine control_print(Model) print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm + print *, ' use_cice_alb : ', Model%use_cice_alb print *, ' ' print *, 'integrated dynamics through earth atmosphere' print *, ' lsidea : ', Model%lsidea diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index af687f25a..1401e8fc7 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1328,38 +1328,38 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdvis_ice] +[albdirvis_ice] standard_name = surface_albedo_direct_visible_over_ice long_name = direct surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdnir_ice] - standard_name = surface_albedo_direct_NIR_over_ice - long_name = direct surface albedo NIR band over ice + active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) +[albdifvis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albivis_ice] - standard_name = surface_albedo_diffuse_visible_over_ice - long_name = diffuse surface albedo visible band over ice + active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) +[albdirnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albinir_ice] + active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) +[albdifnir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = ( flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) + active = (flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) [wetness] standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness for lsm @@ -2181,38 +2181,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[sfc_alb_nir_dir_cpl] - standard_name = surface_nir_albedo_direct_rad_for_coupling - long_name = sfc near IR albedo for direct radiation for coupling - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[sfc_alb_nir_dif_cpl] - standard_name = surface_nir_albedo_diffuse_rad_for_coupling - long_name = sfc near IR albedo for diffuse radiation for coupling - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[sfc_alb_vis_dir_cpl] - standard_name = surface_vis_albedo_direct_rad_for_coupling - long_name = sfc visible albedo for direct radiation for coupling - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) -[sfc_alb_vis_dif_cpl] - standard_name = surface_vis_albedo_diffuse_rad_for_coupling - long_name = sfc visible albedo for diffuse radiation for coupling - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (flag_for_flux_coupling) [slimskin_cpl] standard_name = sea_land_ice_mask_in long_name = sea/land/ice mask input (=0/1/2) @@ -2610,6 +2578,12 @@ units = flag dimensions = () type = logical +[use_cice_alb] + standard_name = flag_for_cice_albedo + long_name = flag for using ice albedos form CICE when coupled (default on) + units = flag + dimensions = () + type = logical [lsidea] standard_name = flag_idealized_physics long_name = flag for idealized physics diff --git a/ccpp/physics b/ccpp/physics index 104815caa..11c3605ec 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 104815caac52631ce6a0942bd81665ddae811490 +Subproject commit 11c3605ec47bbcbcc2cdae13147da7ea971f0617 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index cebc5caa1..01e77d23e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -381,10 +381,16 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%albinir_lnd(ix) temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%sfalb_lnd(ix) temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%sfalb_lnd_bck(ix) - temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdvis_ice(ix) - temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdnir_ice(ix) - temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albivis_ice(ix) - temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albinir_ice(ix) + + temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdirvis_ice(ix) + temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdirnir_ice(ix) + temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albdifvis_ice(ix) + temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albdifnir_ice(ix) + +! temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdvis_ice(ix) +! temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdnir_ice(ix) +! temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albivis_ice(ix) +! temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albinir_ice(ix) temp2d(i,j,idx_opt+20) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) temp2d(i,j,idx_opt+21) = GFS_Data(nb)%Sfcprop%emis_lnd(ix) temp2d(i,j,idx_opt+22) = GFS_Data(nb)%Sfcprop%emis_ice(ix) @@ -634,6 +640,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo nvar_s2m = 39 + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + nvar_s2m = nvar_s2m + 4 +! nvar_s2m = nvar_s2m + 5 + endif if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif @@ -791,6 +801,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(37) = 'tsfc' !tsfc composite sfc_name2(38) = 'zorl' !zorl composite sfc_name2(39) = 'weasdl'!weasd on land portion of a cell + + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + sfc_name2(40) = 'albdirvis_ice' + sfc_name2(41) = 'albdifvis_ice' + sfc_name2(42) = 'albdirnir_ice' + sfc_name2(43) = 'albdifnir_ice' +! sfc_name2(44) = 'sfalb_ice' + endif + if(Model%cplwav) then sfc_name2(nvar_s2m) = 'zorlwav' !zorl on land portion of a cell endif @@ -847,10 +866,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+45) = 'smcwtdxy' sfc_name2(nvar_s2m+46) = 'deeprechxy' sfc_name2(nvar_s2m+47) = 'rechxy' - sfc_name2(nvar_s2m+48) = 'albdvis_lnd' - sfc_name2(nvar_s2m+49) = 'albdnir_lnd' - sfc_name2(nvar_s2m+50) = 'albivis_lnd' - sfc_name2(nvar_s2m+51) = 'albinir_lnd' + sfc_name2(nvar_s2m+48) = 'albdirvis_lnd' + sfc_name2(nvar_s2m+49) = 'albdirnir_lnd' + sfc_name2(nvar_s2m+50) = 'albdifvis_lnd' + sfc_name2(nvar_s2m+51) = 'albdifnir_lnd' sfc_name2(nvar_s2m+52) = 'emis_lnd' else if (Model%lsm == Model%lsm_ruc .and. warm_start) then sfc_name2(nvar_s2m+19) = 'wetness' @@ -863,21 +882,25 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+26) = 'snowfall_acc_land' sfc_name2(nvar_s2m+27) = 'snowfall_acc_ice' sfc_name2(nvar_s2m+28) = 'sncovr_ice' - sfc_name2(nvar_s2m+29) = 'albdvis_lnd' - sfc_name2(nvar_s2m+30) = 'albdnir_lnd' - sfc_name2(nvar_s2m+31) = 'albivis_lnd' - sfc_name2(nvar_s2m+32) = 'albinir_lnd' + sfc_name2(nvar_s2m+29) = 'albdirvis_lnd' + sfc_name2(nvar_s2m+30) = 'albdirnir_lnd' + sfc_name2(nvar_s2m+31) = 'albdifvis_lnd' + sfc_name2(nvar_s2m+32) = 'albdifnir_lnd' sfc_name2(nvar_s2m+33) = 'sfalb_lnd' sfc_name2(nvar_s2m+34) = 'sfalb_lnd_bck' - sfc_name2(nvar_s2m+35) = 'albdvis_ice' - sfc_name2(nvar_s2m+36) = 'albdnir_ice' - sfc_name2(nvar_s2m+37) = 'albivis_ice' - sfc_name2(nvar_s2m+38) = 'albinir_ice' - sfc_name2(nvar_s2m+39) = 'sfalb_ice' - sfc_name2(nvar_s2m+40) = 'emis_lnd' - sfc_name2(nvar_s2m+41) = 'emis_ice' +! sfc_name2(nvar_s2m+35) = 'albdvis_ice' +! sfc_name2(nvar_s2m+36) = 'albdnir_ice' +! sfc_name2(nvar_s2m+37) = 'albivis_ice' +! sfc_name2(nvar_s2m+38) = 'albinir_ice' +! sfc_name2(nvar_s2m+39) = 'sfalb_ice' +! sfc_name2(nvar_s2m+40) = 'emis_lnd' +! sfc_name2(nvar_s2m+41) = 'emis_ice' + sfc_name2(nvar_s2m+35) = 'sfalb_ice' + sfc_name2(nvar_s2m+36) = 'emis_lnd' + sfc_name2(nvar_s2m+37) = 'emis_ice' if (Model%rdlai) then - sfc_name2(nvar_s2m+42) = 'lai' +! sfc_name2(nvar_s2m+42) = 'lai' + sfc_name2(nvar_s2m+38) = 'lai' endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' @@ -889,6 +912,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' & + .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifnir_ice' & +! .or. trim(sfc_name2(num)) == 'sfalb_ice' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorl') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else @@ -1041,6 +1069,13 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%tsfc(ix) = sfc_var2(i,j,37) !--- tsfc composite Sfcprop(nb)%zorl(ix) = sfc_var2(i,j,38) !--- zorl composite Sfcprop(nb)%weasdl(ix) = sfc_var2(i,j,39) !--- weasdl (weasd on land portion of a cell) + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,40) + Sfcprop(nb)%albdifvis_ice(ix) = sfc_var2(i,j,41) + Sfcprop(nb)%albdirnir_ice(ix) = sfc_var2(i,j,42) + Sfcprop(nb)%albdifnir_ice(ix) = sfc_var2(i,j,43) +! Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,44) + endif if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorw from wave model) else @@ -1199,15 +1234,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%albinir_lnd(ix) = sfc_var2(i,j,nvar_s2m+32) Sfcprop(nb)%sfalb_lnd(ix) = sfc_var2(i,j,nvar_s2m+33) Sfcprop(nb)%sfalb_lnd_bck(ix) = sfc_var2(i,j,nvar_s2m+34) - Sfcprop(nb)%albdvis_ice(ix) = sfc_var2(i,j,nvar_s2m+35) - Sfcprop(nb)%albdnir_ice(ix) = sfc_var2(i,j,nvar_s2m+36) - Sfcprop(nb)%albivis_ice(ix) = sfc_var2(i,j,nvar_s2m+37) - Sfcprop(nb)%albinir_ice(ix) = sfc_var2(i,j,nvar_s2m+38) +! Sfcprop(nb)%albdvis_ice(ix) = sfc_var2(i,j,nvar_s2m+35) +! Sfcprop(nb)%albdnir_ice(ix) = sfc_var2(i,j,nvar_s2m+36) +! Sfcprop(nb)%albivis_ice(ix) = sfc_var2(i,j,nvar_s2m+37) +! Sfcprop(nb)%albinir_ice(ix) = sfc_var2(i,j,nvar_s2m+38) Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+39) Sfcprop(nb)%emis_lnd(ix) = sfc_var2(i,j,nvar_s2m+40) Sfcprop(nb)%emis_ice(ix) = sfc_var2(i,j,nvar_s2m+41) if (Model%rdlai) then - Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+42) +! Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+42) + Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+37) endif else if (Model%lsm == Model%lsm_ruc) then ! Initialize RUC snow cover on ice from snow cover @@ -1359,6 +1395,23 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif + if (Model%use_cice_alb) then + if (sfc_var2(i,j,40) < -9990.0_r8) then +!$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%oceanfrac(ix) > zero .and. & + Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%albdirvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdirnir_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifnir_ice(ix) = 0.6_kind_phys + endif + enddo + enddo + endif + endif + ! Fill in composite tsfc and zorl for coldstart runs compute_tsfc_zorl_for_colstart: if (.not. warm_start) then if(Model%frac_grid) then ! 3-way composite @@ -1454,6 +1507,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! if (Model%frac_grid) then ! needs more variables nvar2m = 39 + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + nvar2m = nvar2m + 4 +! nvar2m = nvar2m + 5 + endif ! else ! nvar2m = 32 ! endif @@ -1461,9 +1518,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2o = 18 if (Model%lsm == Model%lsm_ruc) then if (Model%rdlai) then - nvar2r = 24 +! nvar2r = 24 + nvar2r = 19 else - nvar2r = 23 +! nvar2r = 23 + nvar2r = 18 endif nvar3 = 5 else @@ -1567,6 +1626,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(38) = 'zorl' !zorl composite sfc_name2(39) = 'weasd' !weasd on land portion of a cell ! endif + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + sfc_name2(40) = 'albdirvis_ice' + sfc_name2(41) = 'albdifvis_ice' + sfc_name2(42) = 'albdirnir_ice' + sfc_name2(43) = 'albdifnir_ice' +! sfc_name2(44) = 'sfalb_ice' + endif if (Model%cplwav) then sfc_name2(nvar2m) = 'zorlwav' !zorl on land portion of a cell endif @@ -1655,6 +1721,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' & + .or. trim(sfc_name2(num)) == 'albdifvis_ice' & + .or. trim(sfc_name2(num)) == 'albdirnir_ice' & + .or. trim(sfc_name2(num)) == 'albdifnir_ice' & +! .or. trim(sfc_name2(num)) == 'sfalb_ice' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorl') then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else @@ -1832,10 +1903,17 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%albinir_lnd(ix) sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+34) = Sfcprop(nb)%sfalb_lnd_bck(ix) - sfc_var2(i,j,nvar2m+35) = Sfcprop(nb)%albdvis_ice(ix) - sfc_var2(i,j,nvar2m+36) = Sfcprop(nb)%albdnir_ice(ix) - sfc_var2(i,j,nvar2m+37) = Sfcprop(nb)%albivis_ice(ix) - sfc_var2(i,j,nvar2m+38) = Sfcprop(nb)%albinir_ice(ix) + + sfc_var2(i,j,nvar2m+35) = Sfcprop(nb)%albdirvis_ice(ix) + sfc_var2(i,j,nvar2m+36) = Sfcprop(nb)%albdirnir_ice(ix) + sfc_var2(i,j,nvar2m+37) = Sfcprop(nb)%albdifvis_ice(ix) + sfc_var2(i,j,nvar2m+38) = Sfcprop(nb)%albdifnir_ice(ix) + +! sfc_var2(i,j,nvar2m+35) = Sfcprop(nb)%albdvis_ice(ix) +! sfc_var2(i,j,nvar2m+36) = Sfcprop(nb)%albdnir_ice(ix) +! sfc_var2(i,j,nvar2m+37) = Sfcprop(nb)%albivis_ice(ix) +! sfc_var2(i,j,nvar2m+38) = Sfcprop(nb)%albinir_ice(ix) + sfc_var2(i,j,nvar2m+39) = Sfcprop(nb)%sfalb_ice(ix) sfc_var2(i,j,nvar2m+40) = Sfcprop(nb)%emis_lnd(ix) sfc_var2(i,j,nvar2m+41) = Sfcprop(nb)%emis_ice(ix) From d0e2c0cc9b11490e17446f01a19868bfbccb62a0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 9 Jul 2021 13:28:55 +0000 Subject: [PATCH 166/217] reverting post_gfs to my version as the develop version can't handle MG3 microphysics option --- io/post_gfs.F90 | 925 +++++++++++++++++++++++++----------------------- 1 file changed, 482 insertions(+), 443 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 0907d7d76..63a0f2c8f 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -29,7 +29,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,im, nsoil, filenameflat, me use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -81,6 +81,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount + me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct @@ -112,19 +113,20 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -137,16 +139,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. + setvar_atmfile = .false. + setvar_sfcfile = .false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP +! 20190807 need to call microinit only for Ferrier microphysics ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -157,7 +159,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & else if(ifhr > 0) then filenameflat = 'postxconfig-NT.txt' if(associated(paramset)) then - if( size(paramset)>0) then + if(size(paramset)>0) then do i=1,size(paramset) if (associated(paramset(i)%param)) then if (size(paramset(i)%param)>0) then @@ -247,66 +249,62 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n>1) then + else if(n > 1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then + else if(trim(attName) == "bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n>1) then - if(trim(attName) =="ak") then + else if(n > 1) then + if(trim(attName) == "ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -342,7 +340,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -370,11 +369,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -399,12 +398,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -483,7 +482,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -494,7 +493,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -506,10 +505,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -517,6 +516,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs + dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -524,22 +524,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL - enddo - enddo -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? enddo enddo @@ -614,7 +608,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -730,19 +724,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -754,19 +748,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -778,9 +770,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -788,29 +779,27 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -818,14 +807,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -834,18 +823,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j)=arrayr42d(i,j) + fis(i,j) = arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) +!!$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend ! pint(i,j,lp1)=arrayr42d(i,j) @@ -854,38 +843,38 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! endif ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j)=arrayr42d(i,j) + pblh(i,j) = arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j)=arrayr42d(i,j) + ustar(i,j) = arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j)=arrayr42d(i,j) + z0(i,j) = arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -894,18 +883,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j)=arrayr42d(i,j) + acond(i,j) = arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -916,114 +905,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1032,8 +1021,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1042,8 +1031,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1055,8 +1044,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1068,8 +1057,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1081,8 +1070,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1094,8 +1083,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1107,8 +1096,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1120,8 +1109,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1133,8 +1122,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1147,8 +1136,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1159,8 +1148,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1174,8 +1163,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1189,8 +1178,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1205,8 +1194,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1216,8 +1205,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1227,8 +1216,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1238,8 +1227,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1249,8 +1238,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1260,8 +1249,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1271,8 +1260,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1282,8 +1271,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1293,8 +1282,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1305,8 +1294,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1317,8 +1306,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1329,8 +1318,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1342,7 +1331,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1351,8 +1340,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1361,8 +1350,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1372,8 +1361,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1382,8 +1371,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1392,8 +1381,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1402,8 +1391,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1412,8 +1401,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1422,8 +1411,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1432,8 +1421,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1443,8 +1432,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1453,8 +1442,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1463,8 +1452,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1474,8 +1463,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1485,8 +1474,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1497,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1508,8 +1497,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1519,30 +1508,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1551,8 +1540,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1561,8 +1550,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1571,8 +1560,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1581,30 +1570,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1614,8 +1603,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1625,8 +1614,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1639,8 +1628,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1653,8 +1642,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1664,8 +1653,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1675,8 +1664,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1685,8 +1674,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1695,8 +1684,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1705,8 +1694,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1715,8 +1704,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1725,8 +1714,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1735,8 +1724,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1745,8 +1734,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1755,8 +1744,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1765,8 +1754,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1776,8 +1765,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1786,8 +1775,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1797,8 +1786,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1807,8 +1796,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1817,8 +1806,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1827,8 +1816,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1838,8 +1827,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1848,8 +1837,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1859,8 +1848,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1869,8 +1858,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1879,8 +1868,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1889,8 +1878,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1899,8 +1888,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1909,8 +1898,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1919,8 +1908,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1929,8 +1918,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1939,8 +1928,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1949,8 +1938,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1959,8 +1948,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1969,8 +1958,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1979,8 +1968,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1990,8 +1979,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -2001,8 +1990,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2012,8 +2001,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2023,19 +2012,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval enddo enddo endif ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2045,8 +2034,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2056,19 +2045,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then + else if (fieldDimCount == 3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2078,8 +2065,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2089,7 +2076,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2099,172 +2086,237 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) + q(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) + uh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) + vh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) + dpres(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) + zint(i,j,l) = -arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) + wh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) + o3(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL MP - if (imp_physics == 11) then +! for GFDL or MG3 MP +! ------------------ + if (imp_physics == 10 .or. imp_physics == 11) then ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) + qqw(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) + qqi(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) + qqr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) + qqs(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqns(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -!gfdlmp - endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif ! for MG3 MP ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) + cfr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) + ref_10cm(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2272,12 +2324,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) + q2(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2285,8 +2337,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif -! end loop ncount_field - enddo + enddo ! end loop ncount_field if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2312,46 +2363,33 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - end do - end do + pd(i,j) = spval + enddo + enddo do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) !compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) enddo enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2359,22 +2397,23 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2400,13 +2439,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp - if( imp_physics == 11 ) then +! compute cwm for gfdlmp or MG3 + if( imp_physics == 10 .or. imp_physics == 11) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) enddo enddo enddo @@ -2416,8 +2455,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2428,13 +2467,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l + htop(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! hbot do j=jsta,jend From 37eb3ccb768f2725441b7d80fc4e4dc7d28b992c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 9 Jul 2021 19:30:09 +0000 Subject: [PATCH 167/217] reverting chanege to calling assign_importdata in atmos_model.F90 --- atmos_model.F90 | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 818a2cf0c..8d6fd3407 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -271,8 +271,8 @@ subroutine update_atmos_radiation_physics (Atmos) !--- if coupled, assign coupled fields -! if (.not. GFS_control%cplchm) then - if (GFS_control%cplflx .or. GFS_control%cplwav2atm) then + if (.not. GFS_control%cplchm) then +! if (GFS_control%cplflx .or. GFS_control%cplwav2atm) then call assign_importdata(rc) endif diff --git a/ccpp/physics b/ccpp/physics index 11c3605ec..8b1e40c87 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 11c3605ec47bbcbcc2cdae13147da7ea971f0617 +Subproject commit 8b1e40c873a0c23465e324806383f4a21b40101b From 5a6212df7adbfe72ca3366533af8cad88694a4f3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 15 Jul 2021 18:38:57 +0000 Subject: [PATCH 168/217] updating .gitmodule to update physics --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index f08542a42..a421ce324 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Jul142021 + branch = SM_Jul152021 diff --git a/ccpp/physics b/ccpp/physics index 719c1623a..d8139158b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 719c1623ad184ed7ac86cd85fe9a1adf6f64ac4f +Subproject commit d8139158bf6efa741aa4f07699f097a5ed2fabc2 From 4d9cd0e16f28f74f93045546b038956dfdcf482e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 23 Jul 2021 20:28:28 -0400 Subject: [PATCH 169/217] updating .gitmodules --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index a421ce324..eb212eec1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_May042021 + branch = SM_Jul232021 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Jul152021 + branch = SM_Jul232021 From 214ed4236274e2f2d6049077389b24e9a01ad35b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 26 Jul 2021 09:24:06 -0400 Subject: [PATCH 170/217] after some fix io.F90 --- ccpp/data/GFS_typedefs.F90 | 4 ++- io/FV3GFS_io.F90 | 73 ++++++++++++++++++++++---------------- 2 files changed, 46 insertions(+), 31 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 3d98be2d1..2215954c2 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -4985,8 +4985,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & if (Model%do_gwd) then if (Model%do_ugwp) then print *,' Unified gravity wave drag parameterization used' + elseif (Model%gwd_opt == 2) then + print *,'GSL unified oragraphic gravity wave drag parameterization used' else - print *,' Original mountain blocking and oragraphic gravity wave drag parameterization used' + print *,' Original mountain blocking and oragraphic gravity wave drag parameterization used' if (cdmbgwd(3) > 0.0) print *,' non-statioary gravity wave drag parameterization used' endif print *,' do_gwd=',Model%do_gwd diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index e89d92507..56f223a39 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -312,6 +312,14 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,91) = GFS_Data(nb)%Sfcprop%emis_lnd(ix) idx_opt = 92 + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%albdirvis_ice(ix) + temp2d(i,j,idx_opt+2) = GFS_Data(nb)%Sfcprop%albdirnir_ice(ix) + temp2d(i,j,idx_opt+3) = GFS_Data(nb)%Sfcprop%albdifvis_ice(ix) + temp2d(i,j,idx_opt+4) = GFS_Data(nb)%Sfcprop%albdifnir_ice(ix) + endif + idx_opt = idx_opt + 5 + if (Model%lsm == Model%lsm_noahmp) then temp2d(i,j,idx_opt) = GFS_Data(nb)%Sfcprop%snowxy(ix) temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%tvxy(ix) @@ -363,7 +371,7 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+46) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,2) temp2d(i,j,idx_opt+47) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,3) temp2d(i,j,idx_opt+48) = GFS_Data(nb)%Sfcprop%zsnsoxy(ix,4) - idx_opt = 141 + idx_opt = idx_opt + 49 elseif (Model%lsm == Model%lsm_ruc) then temp2d(i,j,idx_opt) = GFS_Data(nb)%Sfcprop%wetness(ix) temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%clw_surf_land(ix) @@ -381,9 +389,9 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) ! temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdnir_ice(ix) ! temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albivis_ice(ix) ! temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albinir_ice(ix) - temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) - temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%emis_ice(ix) - idx_opt = 110 + temp2d(i,j,idx_opt+12) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) + temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%emis_ice(ix) + idx_opt = idx_opt + 14 if (Model%rdlai) then temp2d(i,j,idx_opt+23) = GFS_Data(nb)%Sfcprop%xlaixy(ix) idx_opt = idx_opt + 1 @@ -514,9 +522,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%lsm == Model%lsm_ruc .and. warm_start) then if(Model%rdlai) then - nvar_s2r = 19 + nvar_s2r = 15 else - nvar_s2r = 18 + nvar_s2r = 14 end if nvar_s3 = 5 else @@ -628,7 +636,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - nvar_s2m = 39 nvar_s2m = 44 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar_s2m = nvar_s2m + 4 @@ -874,14 +881,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+28) = 'sncovr_ice' sfc_name2(nvar_s2m+29) = 'sfalb_lnd' sfc_name2(nvar_s2m+30) = 'sfalb_lnd_bck' - sfc_name2(nvar_s2m+31) = 'albdvis_ice' - sfc_name2(nvar_s2m+32) = 'albdnir_ice' - sfc_name2(nvar_s2m+33) = 'albivis_ice' - sfc_name2(nvar_s2m+34) = 'albinir_ice' - sfc_name2(nvar_s2m+35) = 'sfalb_ice' - sfc_name2(nvar_s2m+36) = 'emis_ice' +! sfc_name2(nvar_s2m+31) = 'albdvis_ice' +! sfc_name2(nvar_s2m+32) = 'albdnir_ice' +! sfc_name2(nvar_s2m+33) = 'albivis_ice' +! sfc_name2(nvar_s2m+34) = 'albinir_ice' + sfc_name2(nvar_s2m+31) = 'sfalb_ice' + sfc_name2(nvar_s2m+32) = 'emis_ice' if (Model%rdlai) then - sfc_name2(nvar_s2m+37) = 'lai' + sfc_name2(nvar_s2m+33) = 'lai' endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' @@ -1067,7 +1074,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorl from wave model) else - Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorl(ix) + Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif if (Model%frac_grid) then @@ -1222,10 +1229,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Sfcprop(nb)%albdnir_ice(ix) = sfc_var2(i,j,nvar_s2m+32) ! Sfcprop(nb)%albivis_ice(ix) = sfc_var2(i,j,nvar_s2m+33) ! Sfcprop(nb)%albinir_ice(ix) = sfc_var2(i,j,nvar_s2m+34) - Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+35) - Sfcprop(nb)%emis_ice(ix) = sfc_var2(i,j,nvar_s2m+36) + Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+31) + Sfcprop(nb)%emis_ice(ix) = sfc_var2(i,j,nvar_s2m+32) if (Model%rdlai) then - Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+37) + Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+33) endif else if (Model%lsm == Model%lsm_ruc) then ! Initialize RUC snow cover on ice from snow cover @@ -1394,7 +1401,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif if (Model%use_cice_alb) then - if (sfc_var2(i,j,40) < -9990.0_r8) then + if (sfc_var2(i,j,45) < -9990.0_r8) then !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -1501,7 +1508,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2m = nvar2m + 4 ! nvar2m = nvar2m + 5 endif - nvar2m = 44 if (Model%cplwav) nvar2m = nvar2m + 1 nvar2o = 18 if (Model%lsm == Model%lsm_ruc) then @@ -1659,14 +1665,14 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+28) = 'sncovr_ice' sfc_name2(nvar2m+29) = 'sfalb_lnd' sfc_name2(nvar2m+30) = 'sfalb_lnd_bck' - sfc_name2(nvar2m+31) = 'albdvis_ice' - sfc_name2(nvar2m+32) = 'albdnir_ice' - sfc_name2(nvar2m+33) = 'albivis_ice' - sfc_name2(nvar2m+34) = 'albinir_ice' - sfc_name2(nvar2m+35) = 'sfalb_ice' - sfc_name2(nvar2m+36) = 'emis_ice' +! sfc_name2(nvar2m+31) = 'albdvis_ice' +! sfc_name2(nvar2m+32) = 'albdnir_ice' +! sfc_name2(nvar2m+33) = 'albivis_ice' +! sfc_name2(nvar2m+34) = 'albinir_ice' + sfc_name2(nvar2m+31) = 'sfalb_ice' + sfc_name2(nvar2m+32) = 'emis_ice' if (Model%rdlai) then - sfc_name2(nvar2m+37) = 'lai' + sfc_name2(nvar2m+33) = 'lai' endif else if(Model%lsm == Model%lsm_noahmp) then ! Only needed when Noah MP LSM is used - 29 2D @@ -1848,6 +1854,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,42) = Sfcprop(nb)%albivis_lnd(ix) sfc_var2(i,j,43) = Sfcprop(nb)%albinir_lnd(ix) sfc_var2(i,j,44) = Sfcprop(nb)%emis_lnd(ix) + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + sfc_var2(i,j,45) = Sfcprop(nb)%albdirvis_ice(ix) + sfc_var2(i,j,46) = Sfcprop(nb)%albdifvis_ice(ix) + sfc_var2(i,j,47) = Sfcprop(nb)%albdirnir_ice(ix) + sfc_var2(i,j,48) = Sfcprop(nb)%albdifnir_ice(ix) +! sfc_var2(i,j,49) = Sfcprop(nb)%sfalb_ice(ix) + endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) endif @@ -1891,10 +1904,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%albdnir_ice(ix) ! sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%albivis_ice(ix) ! sfc_var2(i,j,nvar2m+34) = Sfcprop(nb)%albinir_ice(ix) - sfc_var2(i,j,nvar2m+35) = Sfcprop(nb)%sfalb_ice(ix) - sfc_var2(i,j,nvar2m+36) = Sfcprop(nb)%emis_ice(ix) + sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%sfalb_ice(ix) + sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%emis_ice(ix) if (Model%rdlai) then - sfc_var2(i,j,nvar2m+37) = Sfcprop(nb)%xlaixy(ix) + sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%xlaixy(ix) endif else if (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables From 4a6120f13059897efbdc31a1a987950dd4f3ef98 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 26 Jul 2021 10:46:50 -0400 Subject: [PATCH 171/217] changing some names to make land and ice albedos arrays consistent --- ccpp/data/GFS_typedefs.F90 | 40 +++++++------- ccpp/data/GFS_typedefs.meta | 8 +-- io/FV3GFS_io.F90 | 102 +++++++++++++++++------------------- 3 files changed, 73 insertions(+), 77 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 2215954c2..52dcf7545 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -325,10 +325,10 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smcwtdxy(:) => null() !< real (kind=kind_phys), pointer :: deeprechxy(:)=> null() !< real (kind=kind_phys), pointer :: rechxy (:) => null() !< - real (kind=kind_phys), pointer :: albdvis_lnd (:) => null() !< - real (kind=kind_phys), pointer :: albdnir_lnd (:) => null() !< - real (kind=kind_phys), pointer :: albivis_lnd (:) => null() !< - real (kind=kind_phys), pointer :: albinir_lnd (:) => null() !< + real (kind=kind_phys), pointer :: albdirvis_lnd (:) => null() !< + real (kind=kind_phys), pointer :: albdirnir_lnd (:) => null() !< + real (kind=kind_phys), pointer :: albdifvis_lnd (:) => null() !< + real (kind=kind_phys), pointer :: albdifnir_lnd (:) => null() !< real (kind=kind_phys), pointer :: albdirvis_ice (:) => null() !< real (kind=kind_phys), pointer :: albdifvis_ice (:) => null() !< @@ -2372,10 +2372,10 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%weasdl (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) - allocate(Sfcprop%albdvis_lnd (IM)) - allocate(Sfcprop%albdnir_lnd (IM)) - allocate(Sfcprop%albivis_lnd (IM)) - allocate(Sfcprop%albinir_lnd (IM)) + allocate(Sfcprop%albdirvis_lnd (IM)) + allocate(Sfcprop%albdirnir_lnd (IM)) + allocate(Sfcprop%albdifvis_lnd (IM)) + allocate(Sfcprop%albdifnir_lnd (IM)) allocate (Sfcprop%emis_lnd (IM)) Sfcprop%slmsk = clear_val @@ -2399,10 +2399,10 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%weasdl = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val - Sfcprop%albdvis_lnd = clear_val - Sfcprop%albdnir_lnd = clear_val - Sfcprop%albivis_lnd = clear_val - Sfcprop%albinir_lnd = clear_val + Sfcprop%albdirvis_lnd = clear_val + Sfcprop%albdirnir_lnd = clear_val + Sfcprop%albdifvis_lnd = clear_val + Sfcprop%albdifnir_lnd = clear_val Sfcprop%emis_lnd = clear_val !--- In (radiation only) @@ -2468,10 +2468,10 @@ subroutine sfcprop_create (Sfcprop, IM, Model) if (Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%sncovr_ice (IM)) allocate (Sfcprop%emis_ice (IM)) -! allocate (Sfcprop%albdvis_ice (IM)) -! allocate (Sfcprop%albdnir_ice (IM)) -! allocate (Sfcprop%albivis_ice (IM)) -! allocate (Sfcprop%albinir_ice (IM)) +! allocate (Sfcprop%albdirvis_ice (IM)) +! allocate (Sfcprop%albdirnir_ice (IM)) +! allocate (Sfcprop%albdifvis_ice (IM)) +! allocate (Sfcprop%albdifnir_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2499,10 +2499,10 @@ subroutine sfcprop_create (Sfcprop, IM, Model) if (Model%lsm == Model%lsm_ruc) then Sfcprop%sncovr_ice = clear_val Sfcprop%emis_ice = clear_val -! Sfcprop%albdvis_ice = clear_val -! Sfcprop%albdnir_ice = clear_val -! Sfcprop%albivis_ice = clear_val -! Sfcprop%albinir_ice = clear_val +! Sfcprop%albdirvis_ice = clear_val +! Sfcprop%albdirnir_ice = clear_val +! Sfcprop%albdifvis_ice = clear_val +! Sfcprop%albdifnir_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index e23953c50..98dfb4c6c 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1296,7 +1296,7 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noah_wrfv4_land_surface_scheme) -[albdvis_lnd] +[albdirvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land units = frac @@ -1304,7 +1304,7 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albdnir_lnd] +[albdirnir_lnd] standard_name = surface_albedo_direct_NIR_over_land long_name = direct surface albedo NIR band over land units = frac @@ -1312,7 +1312,7 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albivis_lnd] +[albdifvis_lnd] standard_name = surface_albedo_diffuse_visible_over_land long_name = diffuse surface albedo visible band over land units = frac @@ -1320,7 +1320,7 @@ type = real kind = kind_phys active = (flag_for_land_surface_scheme == flag_for_noahmp_land_surface_scheme .or. flag_for_land_surface_scheme == flag_for_ruc_land_surface_scheme) -[albinir_lnd] +[albdifnir_lnd] standard_name = surface_albedo_diffuse_NIR_over_land long_name = diffuse surface albedo NIR band over land units = frac diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 56f223a39..59ba37e96 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -305,10 +305,10 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,84) = GFS_Data(nb)%Radtend%sfcflw(ix)%dnfx0 temp2d(i,j,85) = GFS_Data(nb)%Sfcprop%tiice(ix,1) temp2d(i,j,86) = GFS_Data(nb)%Sfcprop%tiice(ix,2) - temp2d(i,j,87) = GFS_Data(nb)%Sfcprop%albdvis_lnd(ix) - temp2d(i,j,88) = GFS_Data(nb)%Sfcprop%albdnir_lnd(ix) - temp2d(i,j,89) = GFS_Data(nb)%Sfcprop%albivis_lnd(ix) - temp2d(i,j,90) = GFS_Data(nb)%Sfcprop%albinir_lnd(ix) + temp2d(i,j,87) = GFS_Data(nb)%Sfcprop%albdirvis_lnd(ix) + temp2d(i,j,88) = GFS_Data(nb)%Sfcprop%albdirnir_lnd(ix) + temp2d(i,j,89) = GFS_Data(nb)%Sfcprop%albdifvis_lnd(ix) + temp2d(i,j,90) = GFS_Data(nb)%Sfcprop%albdifnir_lnd(ix) temp2d(i,j,91) = GFS_Data(nb)%Sfcprop%emis_lnd(ix) idx_opt = 92 @@ -385,10 +385,10 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+9) = GFS_Data(nb)%Sfcprop%sncovr_ice(ix) temp2d(i,j,idx_opt+10) = GFS_Data(nb)%Sfcprop%sfalb_lnd(ix) temp2d(i,j,idx_opt+11) = GFS_Data(nb)%Sfcprop%sfalb_lnd_bck(ix) -! temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdvis_ice(ix) -! temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdnir_ice(ix) -! temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albivis_ice(ix) -! temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albinir_ice(ix) +! temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdirvis_ice(ix) +! temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdirnir_ice(ix) +! temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albdifvis_ice(ix) +! temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albdifnir_ice(ix) temp2d(i,j,idx_opt+12) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%emis_ice(ix) idx_opt = idx_opt + 14 @@ -798,10 +798,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(37) = 'zorlw' !zorl on water portion of a cell sfc_name2(38) = 'zorll' !zorl on land portion of a cell sfc_name2(39) = 'zorli' !zorl on ice portion of a cell - sfc_name2(40) = 'albdvis_lnd' - sfc_name2(41) = 'albdnir_lnd' - sfc_name2(42) = 'albivis_lnd' - sfc_name2(43) = 'albinir_lnd' + sfc_name2(40) = 'albdirvis_lnd' + sfc_name2(41) = 'albdirnir_lnd' + sfc_name2(42) = 'albdifvis_lnd' + sfc_name2(43) = 'albdifnir_lnd' sfc_name2(44) = 'emis_lnd' if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -881,10 +881,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+28) = 'sncovr_ice' sfc_name2(nvar_s2m+29) = 'sfalb_lnd' sfc_name2(nvar_s2m+30) = 'sfalb_lnd_bck' -! sfc_name2(nvar_s2m+31) = 'albdvis_ice' -! sfc_name2(nvar_s2m+32) = 'albdnir_ice' -! sfc_name2(nvar_s2m+33) = 'albivis_ice' -! sfc_name2(nvar_s2m+34) = 'albinir_ice' +! sfc_name2(nvar_s2m+31) = 'albdirvis_ice' +! sfc_name2(nvar_s2m+32) = 'albdirnir_ice' +! sfc_name2(nvar_s2m+33) = 'albdifvis_ice' +! sfc_name2(nvar_s2m+34) = 'albdifnir_ice' sfc_name2(nvar_s2m+31) = 'sfalb_ice' sfc_name2(nvar_s2m+32) = 'emis_ice' if (Model%rdlai) then @@ -901,12 +901,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdvis_lnd' .or. trim(sfc_name2(num)) == 'albdnir_lnd' & - .or. trim(sfc_name2(num)) == 'albivis_lnd' .or. trim(sfc_name2(num)) == 'albinir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' & - .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' & - .or. trim(sfc_name2(num)) == 'albdifnir_ice' & + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & + .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & .or. trim(sfc_name2(num)) == 'emis_lnd' ) then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else @@ -1059,10 +1057,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlw(ix) = sfc_var2(i,j,37) !--- zorlw (zorl on water portion of a cell) Sfcprop(nb)%zorll(ix) = sfc_var2(i,j,38) !--- zorll (zorl on land portion of a cell) Sfcprop(nb)%zorli(ix) = sfc_var2(i,j,39) !--- zorli (zorl on ice portion of a cell) - Sfcprop(nb)%albdvis_lnd(ix)= sfc_var2(i,j,40) - Sfcprop(nb)%albdnir_lnd(ix)= sfc_var2(i,j,41) - Sfcprop(nb)%albivis_lnd(ix)= sfc_var2(i,j,42) - Sfcprop(nb)%albinir_lnd(ix)= sfc_var2(i,j,43) + Sfcprop(nb)%albdirvis_lnd(ix) = sfc_var2(i,j,40) + Sfcprop(nb)%albdirnir_lnd(ix) = sfc_var2(i,j,41) + Sfcprop(nb)%albdifvis_lnd(ix) = sfc_var2(i,j,42) + Sfcprop(nb)%albdifnir_lnd(ix) = sfc_var2(i,j,43) Sfcprop(nb)%emis_lnd(ix) = sfc_var2(i,j,44) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,45) @@ -1225,10 +1223,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sncovr_ice(ix) = sfc_var2(i,j,nvar_s2m+28) Sfcprop(nb)%sfalb_lnd(ix) = sfc_var2(i,j,nvar_s2m+29) Sfcprop(nb)%sfalb_lnd_bck(ix) = sfc_var2(i,j,nvar_s2m+30) -! Sfcprop(nb)%albdvis_ice(ix) = sfc_var2(i,j,nvar_s2m+31) -! Sfcprop(nb)%albdnir_ice(ix) = sfc_var2(i,j,nvar_s2m+32) -! Sfcprop(nb)%albivis_ice(ix) = sfc_var2(i,j,nvar_s2m+33) -! Sfcprop(nb)%albinir_ice(ix) = sfc_var2(i,j,nvar_s2m+34) +! Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,nvar_s2m+31) +! Sfcprop(nb)%albdirnir_ice(ix) = sfc_var2(i,j,nvar_s2m+32) +! Sfcprop(nb)%albdifvis_ice(ix) = sfc_var2(i,j,nvar_s2m+33) +! Sfcprop(nb)%albdifnir_ice(ix) = sfc_var2(i,j,nvar_s2m+34) Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+31) Sfcprop(nb)%emis_ice(ix) = sfc_var2(i,j,nvar_s2m+32) if (Model%rdlai) then @@ -1616,10 +1614,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(37) = 'zorlw' !zorl on water portion of a cell sfc_name2(38) = 'zorll' !zorl on land portion of a cell sfc_name2(39) = 'zorli' !zorl on ice portion of a cell - sfc_name2(40) = 'albdvis_lnd' - sfc_name2(41) = 'albdnir_lnd' - sfc_name2(42) = 'albivis_lnd' - sfc_name2(43) = 'albinir_lnd' + sfc_name2(40) = 'albdirvis_lnd' + sfc_name2(41) = 'albdirnir_lnd' + sfc_name2(42) = 'albdifvis_lnd' + sfc_name2(43) = 'albdifnir_lnd' sfc_name2(44) = 'emis_lnd' if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -1665,10 +1663,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+28) = 'sncovr_ice' sfc_name2(nvar2m+29) = 'sfalb_lnd' sfc_name2(nvar2m+30) = 'sfalb_lnd_bck' -! sfc_name2(nvar2m+31) = 'albdvis_ice' -! sfc_name2(nvar2m+32) = 'albdnir_ice' -! sfc_name2(nvar2m+33) = 'albivis_ice' -! sfc_name2(nvar2m+34) = 'albinir_ice' +! sfc_name2(nvar2m+31) = 'albdirvis_ice' +! sfc_name2(nvar2m+32) = 'albdirnir_ice' +! sfc_name2(nvar2m+33) = 'albdifvis_ice' +! sfc_name2(nvar2m+34) = 'albdifnir_ice' sfc_name2(nvar2m+31) = 'sfalb_ice' sfc_name2(nvar2m+32) = 'emis_ice' if (Model%rdlai) then @@ -1714,13 +1712,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & - .or. trim(sfc_name2(num)) == 'albdvis_lnd' .or. trim(sfc_name2(num)) == 'albdnir_lnd' & - .or. trim(sfc_name2(num)) == 'albivis_lnd' .or. trim(sfc_name2(num)) == 'albinir_lnd' & - .or. trim(sfc_name2(num)) == 'albdirvis_ice' & - .or. trim(sfc_name2(num)) == 'albdifvis_ice' & - .or. trim(sfc_name2(num)) == 'albdirnir_ice' & - .or. trim(sfc_name2(num)) == 'albdifnir_ice' & -! .or. trim(sfc_name2(num)) == 'sfalb_ice' & + .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc_name2(num)) == 'albdirvis_ice' .or. trim(sfc_name2(num)) == 'albdifvis_ice' & + .or. trim(sfc_name2(num)) == 'albdirnir_ice' .or. trim(sfc_name2(num)) == 'albdifnir_ice' & +! .or. trim(sfc_name2(num)) == 'sfalb_ice' & .or. trim(sfc_name2(num)) == 'emis_lnd' ) then id_restart = register_restart_field(Sfc_restart, fn_srf, sfc_name2(num), var2_p, domain=fv_domain, mandatory=.false.) else @@ -1849,10 +1845,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,37) = Sfcprop(nb)%zorlw(ix) !--- zorl (zorl on water) sfc_var2(i,j,38) = Sfcprop(nb)%zorll(ix) !--- zorll (zorl on land) sfc_var2(i,j,39) = Sfcprop(nb)%zorli(ix) !--- zorli (zorl on ice) - sfc_var2(i,j,40) = Sfcprop(nb)%albdvis_lnd(ix) - sfc_var2(i,j,41) = Sfcprop(nb)%albdnir_lnd(ix) - sfc_var2(i,j,42) = Sfcprop(nb)%albivis_lnd(ix) - sfc_var2(i,j,43) = Sfcprop(nb)%albinir_lnd(ix) + sfc_var2(i,j,40) = Sfcprop(nb)%albdirvis_lnd(ix) + sfc_var2(i,j,41) = Sfcprop(nb)%albdirnir_lnd(ix) + sfc_var2(i,j,42) = Sfcprop(nb)%albdifvis_lnd(ix) + sfc_var2(i,j,43) = Sfcprop(nb)%albdifnir_lnd(ix) sfc_var2(i,j,44) = Sfcprop(nb)%emis_lnd(ix) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then sfc_var2(i,j,45) = Sfcprop(nb)%albdirvis_ice(ix) @@ -1900,10 +1896,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sncovr_ice(ix) sfc_var2(i,j,nvar2m+29) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+30) = Sfcprop(nb)%sfalb_lnd_bck(ix) -! sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%albdvis_ice(ix) -! sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%albdnir_ice(ix) -! sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%albivis_ice(ix) -! sfc_var2(i,j,nvar2m+34) = Sfcprop(nb)%albinir_ice(ix) +! sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%albdirvis_ice(ix) +! sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%albdirnir_ice(ix) +! sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%albdifvis_ice(ix) +! sfc_var2(i,j,nvar2m+34) = Sfcprop(nb)%albdifnir_ice(ix) sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%sfalb_ice(ix) sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%emis_ice(ix) if (Model%rdlai) then From 71a667b7514bf58d72e4e6312a0bab5bc8511100 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 27 Jul 2021 12:48:38 -0400 Subject: [PATCH 172/217] adding an addtional SDF --- ..._FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml | 91 +++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.xml new file mode 100644 index 000000000..7a4ac83b5 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsstnoahmp_ugwp.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 + GFS_radiation_surface + 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 + noahmpdrv + 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 + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + 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 + phys_tend + + + + + GFS_stochastics + + + + From fdb3c404bedb1dfe165b9c0504c7420c6ef8e3d6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 28 Jul 2021 19:41:43 -0400 Subject: [PATCH 173/217] changing .gitmodules to point to emc/dev version of dynamics --- .gitmodules | 4 ++-- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index eb212eec1..6b7d9c957 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Jul232021 + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + branch = dev/emd [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index eb5c95e97..3a0d35ad3 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit eb5c95e97b78b0edec0b705cd9b28d8e0f77e7ea +Subproject commit 3a0d35ad3efca351d5b1efccfad58eecf8147f2c diff --git a/ccpp/physics b/ccpp/physics index 0883ee623..610fbcb9c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0883ee623fe0c98cb64c62e1cc2536035c40a4ed +Subproject commit 610fbcb9cda926b4a734e9479784f79bdae85c15 From 5da6cfe5e5e4aba357b3c5b8752adb9a655acef3 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 28 Jul 2021 21:07:00 -0400 Subject: [PATCH 174/217] adding dev version of post_gfs.F90 --- io/post_gfs.F90 | 927 +++++++++++++++++++++++------------------------- 1 file changed, 444 insertions(+), 483 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 7f6c746da..105172a86 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -30,7 +30,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat, me + jend,im, nsoil, filenameflat use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -82,7 +82,6 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount - me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct @@ -114,20 +113,19 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -140,16 +138,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -160,7 +158,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & else if(ifhr > 0) then filenameflat = 'postxconfig-NT.txt' if(associated(paramset)) then - if(size(paramset)>0) then + if( size(paramset)>0) then do i=1,size(paramset) if (associated(paramset(i)%param)) then if (size(paramset(i)%param)>0) then @@ -250,62 +248,66 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -341,8 +343,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng, qqnwfa, qqnifa + pint, exch_h, ref_10cm, qqni,qqnr,qqnwfa,qqnifa use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -370,11 +371,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -399,12 +400,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -483,7 +484,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -494,7 +495,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -506,10 +507,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -517,7 +518,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -525,16 +525,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -609,7 +615,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -725,19 +731,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -749,17 +755,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -771,8 +779,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -780,27 +789,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -808,14 +819,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -824,18 +835,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend ! pint(i,j,lp1)=arrayr42d(i,j) @@ -844,38 +855,38 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -884,18 +895,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -906,114 +917,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1022,8 +1033,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1032,8 +1043,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1045,8 +1056,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1058,8 +1069,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1071,8 +1082,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1084,8 +1095,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1097,8 +1108,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1110,8 +1121,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1123,8 +1134,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1137,8 +1148,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1149,8 +1160,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1164,8 +1175,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1179,8 +1190,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1195,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1206,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1217,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1228,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1239,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1250,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1261,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1272,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1283,8 +1294,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1295,8 +1306,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1307,8 +1318,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1319,8 +1330,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1332,7 +1343,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1341,8 +1352,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1351,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1362,8 +1373,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1372,8 +1383,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1382,8 +1393,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1392,8 +1403,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1402,8 +1413,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1412,8 +1423,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1422,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1433,8 +1444,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1443,8 +1454,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1453,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1464,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1475,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1487,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1498,8 +1509,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1509,30 +1520,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1541,8 +1552,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1551,8 +1562,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1561,8 +1572,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1571,30 +1582,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1604,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1615,8 +1626,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1629,8 +1640,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1643,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1654,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1665,8 +1676,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1675,8 +1686,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1685,8 +1696,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1695,8 +1706,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1705,8 +1716,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1715,8 +1726,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1725,8 +1736,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1735,8 +1746,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1745,8 +1756,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1755,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1766,8 +1777,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1776,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1787,8 +1798,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1797,8 +1808,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1807,8 +1818,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1817,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1828,8 +1839,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1838,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1849,8 +1860,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1859,8 +1870,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1869,8 +1880,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1879,8 +1890,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1889,8 +1900,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1899,8 +1910,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1909,8 +1920,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1919,8 +1930,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1929,8 +1940,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1939,8 +1950,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1949,8 +1960,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1959,8 +1970,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1969,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1980,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1991,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2002,8 +2013,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2013,19 +2024,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2035,8 +2046,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2046,17 +2057,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2066,8 +2079,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2077,7 +2090,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2087,218 +2100,152 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP or Thompson MP -! --------------------------------- - if (imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then +! for GFDL MP or Thompson MP + if (imp_physics == 11 .or. imp_physics == 8) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp or Thompson mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - endif ! for MG3 MP - - if(imp_physics == 8) then + if(imp_physics == 8) then ! model level rain number if(trim(fieldname)=='ncrain') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) @@ -2346,28 +2293,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif - endif !if(imp_physics == 8) then + endif !if(imp_physics == 8) then !gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2375,12 +2323,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2388,7 +2336,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2414,33 +2363,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2448,23 +2410,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2490,13 +2451,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 or Thompson - if( imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then +! compute cwm for gfdlmp or Thompson + if( imp_physics == 11 .or. imp_physics == 8) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2506,8 +2467,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2518,13 +2479,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend From e011b4e98787967d396b619d010c34ee9c6f1d63 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 28 Jul 2021 21:38:47 -0400 Subject: [PATCH 175/217] after submodule sync --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 610fbcb9c..0883ee623 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 610fbcb9cda926b4a734e9479784f79bdae85c15 +Subproject commit 0883ee623fe0c98cb64c62e1cc2536035c40a4ed From c04074a66e9188d3724dfa8fa178ee041ca04b67 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Jul 2021 07:15:57 -0400 Subject: [PATCH 176/217] changing hsmax and himax to 1.0e12 --- atmos_model.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index b61b3aa58..bb50a7498 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1644,9 +1644,11 @@ subroutine assign_importdata(rc) logical found, isFieldCreated, lcpl_fice real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm) ! - real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed +! real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed ! real(kind=GFS_kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required - real(kind=GFS_kind_phys), parameter :: hsmax = 100.0 !< maximum snow depth (m) allowed +! real(kind=GFS_kind_phys), parameter :: hsmax = 100.0 !< maximum snow depth (m) allowed + real(kind=GFS_kind_phys), parameter :: himax = 1.0e12 !< maximum ice thickness allowed + real(kind=GFS_kind_phys), parameter :: hsmax = 1.0e12 !< maximum snow depth (m) allowed ! !------------------------------------------------------------------------------ ! From 467ecfbb2f3adb264ffb98863a30f196b88b5211 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Jul 2021 07:37:01 -0400 Subject: [PATCH 177/217] fixin a coment in GFS_typedefs.F90 --- ccpp/data/GFS_typedefs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 8987fba2d..57ac4163b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -633,7 +633,7 @@ module GFS_typedefs logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection - logical :: use_cice_alb !< default .true. if cplflx is .true. else .false. + logical :: use_cice_alb !< default .false. !--- integrated dynamics through earth's atmosphere logical :: lsidea From 283139d0ca03243e1f3a70325fa9fdaa667f8770 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Jul 2021 13:30:07 -0400 Subject: [PATCH 178/217] fix a typo in .gitmodules --- .gitmodules | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6b7d9c957..65323cfb3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere - branch = dev/emd + branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/ccpp/physics b/ccpp/physics index 0e2f5da1f..43c767725 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0e2f5da1faee115371d2e70dfb0ab303e1d739f1 +Subproject commit 43c767725d67ed0d5b0b9dae1ece44ee1983750d From 4fa71a394ef377c8e64d0bac778232e0e46df0aa Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Jul 2021 21:05:41 -0400 Subject: [PATCH 179/217] after merging with SM_Jul272021_cice_alb and reverting to my version of post_gfs --- .gitmodules | 4 +- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- io/post_gfs.F90 | 927 +++++++++++++++++++++++---------------------- 4 files changed, 487 insertions(+), 448 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6b7d9c957..eb212eec1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere - branch = dev/emd + url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere + branch = SM_Jul232021 [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 3a0d35ad3..eb5c95e97 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 3a0d35ad3efca351d5b1efccfad58eecf8147f2c +Subproject commit eb5c95e97b78b0edec0b705cd9b28d8e0f77e7ea diff --git a/ccpp/physics b/ccpp/physics index 0e2f5da1f..43c767725 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0e2f5da1faee115371d2e70dfb0ab303e1d739f1 +Subproject commit 43c767725d67ed0d5b0b9dae1ece44ee1983750d diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 105172a86..7f6c746da 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -30,7 +30,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat + jend,im, nsoil, filenameflat, me use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -82,6 +82,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount + me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct @@ -113,19 +114,20 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -138,16 +140,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. + setvar_atmfile = .false. + setvar_sfcfile = .false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP +! 20190807 need to call microinit only for Ferrier microphysics ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -158,7 +160,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & else if(ifhr > 0) then filenameflat = 'postxconfig-NT.txt' if(associated(paramset)) then - if( size(paramset)>0) then + if(size(paramset)>0) then do i=1,size(paramset) if (associated(paramset(i)%param)) then if (size(paramset(i)%param)>0) then @@ -248,66 +250,62 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__,file=__FILE__))return ! bail out + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return if (typekind==ESMF_TYPEKIND_I4 ) then - if(n==1) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival - if (trim(attName) == 'ncld') wrt_int_state%ncld=varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival + if (trim(attName) == 'ncld') wrt_int_state%ncld = varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival endif - else if (typekind==ESMF_TYPEKIND_R4) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R4) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n>1) then + else if(n > 1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then + else if(trim(attName) == "bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind==ESMF_TYPEKIND_R8) then - if(n==1) then + else if (typekind == ESMF_TYPEKIND_R8) then + if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n>1) then - if(trim(attName) =="ak") then + else if(n > 1) then + if(trim(attName) == "ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -343,7 +341,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, qqni,qqnr,qqnwfa,qqnifa + pint, exch_h, ref_10cm, & + qqnw, qqni, qqnr, qqns, qqng, qqnwfa, qqnifa use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -371,11 +370,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -400,12 +399,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -484,7 +483,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -495,7 +494,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -507,10 +506,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -518,6 +517,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs + dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -525,22 +525,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase) +!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL - enddo - enddo -! GFS does not have convective precip -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) - do j=jsta,jend - do i=1,im - cprate(i,j) = 0. + cprate(i,j) = 0.0 ! GFS does not have convective precip ???? enddo enddo @@ -615,7 +609,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -731,19 +725,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) +!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -755,19 +749,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -779,9 +771,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc=999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + rc = 999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -789,29 +780,27 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field + do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -819,14 +808,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate( arrayr42d(ista:iend,jsta:jend)) - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -835,18 +824,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname)=='hgtsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname) == 'hgtsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j)=arrayr42d(i,j) + fis(i,j) = arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -! !$omp parallel do private(i,j) +!!$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend ! pint(i,j,lp1)=arrayr42d(i,j) @@ -855,38 +844,38 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! endif ! PBL height using nemsio - if(trim(fieldname)=='hpbl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname) == 'hpbl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j)=arrayr42d(i,j) + pblh(i,j) = arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname)=='fricv') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname) == 'fricv') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j)=arrayr42d(i,j) + ustar(i,j) = arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname)=='sfcr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname) == 'sfcr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j)=arrayr42d(i,j) + z0(i,j) = arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname)=='sfexc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname) == 'sfexc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -895,18 +884,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname)=='acond') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname) == 'acond') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j)=arrayr42d(i,j) + acond(i,j) = arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname)=='tmpsfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname) == 'tmpsfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -917,114 +906,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname)=='cpratb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) + if(trim(fieldname) == 'cpratb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate(i,j) = arrayr42d(i,j) * dtq2001 enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname)=='cprat_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) + if(trim(fieldname) =='cprat_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname)=='prateb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) + if(trim(fieldname) == 'prateb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname)=='prate_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) + if(trim(fieldname) == 'prate_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) + avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname)=='tprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) + if(trim(fieldname) == 'tprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp + prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname)=='cnvprcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) + if(trim(fieldname) == 'cnvprcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname)=='weasd') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname) == 'weasd') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname)=='snowc_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname) == 'snowc_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname)=='snod') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname) == 'snod') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname)=='tmp2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname) == 'tmp2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1033,8 +1022,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname)=='spfh2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname) == 'spfh2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1043,8 +1032,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname)=='albdo_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname) == 'albdo_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1056,8 +1045,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='tcdc_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname) == 'tcdc_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1069,8 +1058,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname)=='snoalb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname) == 'snoalb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1082,8 +1071,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname)=='tcdc_avehcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname) == 'tcdc_avehcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1095,8 +1084,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname)=='tcdc_avelcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname) == 'tcdc_avelcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1108,8 +1097,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname)=='tcdc_avemcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname) == 'tcdc_avemcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1121,8 +1110,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname)=='tcdccnvcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname) == 'tcdccnvcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1134,8 +1123,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname)=='sltyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname) == 'sltyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1148,8 +1137,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname)=='cnwat') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname) == 'cnwat') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1160,8 +1149,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname)=='cpofp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname) == 'cpofp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1175,8 +1164,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname)=='tisfc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname) == 'tisfc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1190,8 +1179,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname)=='veg') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname) == 'veg') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1206,8 +1195,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1217,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1228,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1239,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname)=='soill4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname) == 'soill4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1250,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1261,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1272,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1283,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname)=='soilw4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname) == 'soilw4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1294,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt1') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt1') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1306,8 +1295,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt2') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt2') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1318,8 +1307,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt3') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt3') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1330,8 +1319,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname)=='soilt4') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname) == 'soilt4') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1343,7 +1332,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1352,8 +1341,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname)=='dlwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname) == 'dlwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1362,8 +1351,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname)=='ulwrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname) == 'ulwrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1373,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname)=='ulwrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname) == 'ulwrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1383,8 +1372,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname)=='ulwrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname) == 'ulwrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1393,8 +1382,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname)=='dswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname) == 'dswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1403,8 +1392,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname)=='dswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname) == 'dswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1413,8 +1402,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname)=='duvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname) == 'duvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1423,8 +1412,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname)=='cduvb_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname) == 'cduvb_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1433,8 +1422,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname)=='uswrf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname) == 'uswrf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1444,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname)=='uswrf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname) == 'uswrf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1454,8 +1443,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname)=='dswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname) == 'dswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1464,8 +1453,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname)=='uswrf_avetoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname) == 'uswrf_avetoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1475,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname)=='shtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname) == 'shtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1486,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname)=='shtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname) == 'shtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1498,8 +1487,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname)=='lhtfl_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname) == 'lhtfl_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1509,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname)=='lhtfl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname) == 'lhtfl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1520,30 +1509,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname)=='gflux_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname)=='gflux') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname) == 'gflux') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname)=='uflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname) == 'uflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1552,8 +1541,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname)=='vflx_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname) == 'vflx_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1562,8 +1551,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname)=='u-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname) == 'u-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1572,8 +1561,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname)=='v-gwd_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname) == 'v-gwd_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1582,30 +1571,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname)=='pevpr_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname)=='pevpr') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname) == 'pevpr') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname)=='ugrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname) == 'ugrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1615,8 +1604,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname)=='vgrd10m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname) == 'vgrd10m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1626,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname)=='vtype') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname) == 'vtype') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1640,8 +1629,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname)=='sotyp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname) == 'sotyp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1654,8 +1643,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname)=='prescnvclt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname) == 'prescnvclt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1665,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname)=='prescnvclb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname) == 'prescnvclb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1676,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname)=='pres_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname) == 'pres_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1686,8 +1675,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname)=='pres_avelcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname) == 'pres_avelcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1696,8 +1685,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname)=='tmp_avelct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname) == 'tmp_avelct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1706,8 +1695,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname)=='pres_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname) == 'pres_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1716,8 +1705,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname)=='pres_avemcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname) == 'pres_avemcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1726,8 +1715,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname)=='tmp_avemct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname) == 'tmp_avemct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1736,8 +1725,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname)=='pres_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname) == 'pres_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1746,8 +1735,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname)=='pres_avehcb') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname) == 'pres_avehcb') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1756,8 +1745,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname)=='tmp_avehct') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname) == 'tmp_avehct') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1766,8 +1755,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname)=='tcdc_avebndcl') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname) == 'tcdc_avebndcl') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1777,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname)=='cwork_aveclm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname) == 'cwork_aveclm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1787,8 +1776,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname)=='watr_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname) == 'watr_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1798,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname)=='tmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname) == 'tmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1808,8 +1797,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='tmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname) == 'tmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1818,8 +1807,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname)=='icetk') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname) == 'icetk') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1828,8 +1817,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname)=='wilt') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname) == 'wilt') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1839,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname)=='sunsd_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname) == 'sunsd_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1849,8 +1838,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname)=='fldcp') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname) == 'fldcp') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1860,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname)=='vbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname) == 'vbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1870,8 +1859,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname)=='vddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname) == 'vddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1880,8 +1869,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname)=='nbdsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname) == 'nbdsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1890,8 +1879,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname)=='nddsf_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname) == 'nddsf_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1900,8 +1889,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname)=='csulf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname) == 'csulf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1910,8 +1899,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname)=='csulftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname) == 'csulftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1920,8 +1909,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname)=='csusf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname) == 'csusf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1930,8 +1919,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname)=='csusftoa') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname) == 'csusftoa') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1940,8 +1929,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname)=='csdlf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname) == 'csdlf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1950,8 +1939,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname)=='csdsf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname) == 'csdsf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1960,8 +1949,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname)=='spfhmax_max2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmax_max2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1970,8 +1959,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname)=='spfhmin_min2m') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname) == 'spfhmin_min2m') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1980,8 +1969,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname)=='ssrun_acc') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname) == 'ssrun_acc') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1991,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname)=='evbs_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname) == 'evbs_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -2002,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname)=='evcw_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname) == 'evcw_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2013,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname)=='trans_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname) == 'trans_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2024,19 +2013,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname)=='sbsno_ave') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname) == 'sbsno_ave') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval + if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval enddo enddo endif ! total soil moisture - if(trim(fieldname)=='soilm') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname) == 'soilm') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2046,8 +2035,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname)=='snohf') then - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname) == 'snohf') then +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2057,19 +2046,17 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount ==3) then + else if (fieldDimCount == 3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend - !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2079,8 +2066,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname)=='tmp') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname) == 'tmp') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2090,7 +2077,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 - !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) +!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2100,152 +2087,218 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname)=='spfh') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname) == 'spfh') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l)=arrayr43d(i,j,l) + q(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname)=='ugrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname) == 'ugrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l)=arrayr43d(i,j,l) + uh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname)=='vgrd') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname) == 'vgrd') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l)=arrayr43d(i,j,l) + vh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname)=='dpres') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname) == 'dpres') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l)=arrayr43d(i,j,l) + dpres(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname)=='delz') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname) == 'delz') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l)=-1.*arrayr43d(i,j,l) + zint(i,j,l) = -arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname)=='dzdt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname) == 'dzdt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l)=arrayr43d(i,j,l) + wh(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname)=='o3mr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname) == 'o3mr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l)=arrayr43d(i,j,l) + o3(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL MP or Thompson MP - if (imp_physics == 11 .or. imp_physics == 8) then +! for GFDL or MG3 MP or Thompson MP +! --------------------------------- + if (imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then ! model level cloud water mixing ratio - if(trim(fieldname)=='clwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname) == 'clwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l)=arrayr43d(i,j,l) + qqw(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname)=='icmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname) == 'icmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l)=arrayr43d(i,j,l) + qqi(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='rwmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname) == 'rwmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l)=arrayr43d(i,j,l) + qqr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname)=='snmr') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname) == 'snmr') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l)=arrayr43d(i,j,l) + qqs(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname)=='grle') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + if(trim(fieldname) == 'grle') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqg(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + endif !gfdlmp or MG3 mp or Thompson mp +! for MG3 MP +! ---------- + if (imp_physics == 10) then + ! model level cloud water mixing ratio number concentration + if(trim(fieldname) == 'clwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level ice mixing ratio number concentration + if(trim(fieldname) == 'icenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqni(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'rwnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnr(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + + ! model level snow mixing ratio number concentration + if(trim(fieldname) == 'snnc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqg(i,j,l)=arrayr43d(i,j,l) + qqns(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif - if(imp_physics == 8) then + ! model level rain water mixing ratio number concentration + if(trim(fieldname) == 'grlenc') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqng(i,j,l) = arrayr43d(i,j,l) + enddo + enddo + enddo + endif + endif ! for MG3 MP + + if(imp_physics == 8) then ! model level rain number if(trim(fieldname)=='ncrain') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) @@ -2293,29 +2346,28 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif - endif !if(imp_physics == 8) then + endif !if(imp_physics == 8) then !gfdlmp - endif ! model level cloud amount - if(trim(fieldname)=='cld_amt') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname) == 'cld_amt') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l)=arrayr43d(i,j,l) + cfr(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname)=='ref3D') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname) == 'ref3D') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l)=arrayr43d(i,j,l) + ref_10cm(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2323,12 +2375,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname)=='tke') then - !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname) == 'tke') then +!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l)=arrayr43d(i,j,l) + q2(i,j,l) = arrayr43d(i,j,l) enddo enddo enddo @@ -2336,8 +2388,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif -! end loop ncount_field - enddo + enddo ! end loop ncount_field if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2363,46 +2414,33 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - end do - end do + pd(i,j) = spval + enddo + enddo do l=2,lp1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) + ll = l - 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - end do - + pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) !compute pmid from averaged two layer pint - do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) - do j=jsta,jend - do i=1,im - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) + pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) enddo enddo enddo -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) - do j=jsta,jend - do i=1,im - pd(i,j) = spval - pint(i,j,1) = pt - end do - end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2410,22 +2448,23 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l)=log(pint(i,j,l)) - end do - end do - end do + alpint(i,j,l) = log(pint(i,j,l)) + enddo + enddo + enddo ! compute zmid do l=lm,1,-1 -!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) + ll = l + 1 +!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & - (log(pmid(i,j,l))-alpint(i,j,l+1))/ & - (alpint(i,j,l)-alpint(i,j,l+1)) - end do - end do - end do + zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & + * (log(pmid(i,j,l))-alpint(i,j,ll)) & + / (alpint(i,j,l)-alpint(i,j,ll)) + enddo + enddo + enddo ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2451,13 +2490,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or Thompson - if( imp_physics == 11 .or. imp_physics == 8) then +! compute cwm for gfdlmp or MG3 or Thompson + if( imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) + cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) enddo enddo enddo @@ -2467,8 +2506,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2479,13 +2518,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j)=l + htop(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! hbot do j=jsta,jend From 5086bbcea54c960e7958304f7db34ca6c736be95 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 1 Aug 2021 21:45:27 -0400 Subject: [PATCH 180/217] fixing the crash in noahmp in debug mode --- .gitmodules | 2 +- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 16 ++++++++++++++-- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index eb212eec1..444811199 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Jul232021 + branch = SM_Jul302021 diff --git a/ccpp/physics b/ccpp/physics index 43c767725..dfacad08e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 43c767725d67ed0d5b0b9dae1ece44ee1983750d +Subproject commit dfacad08eda5d4aa2171faa1fd709a18d909cdd9 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 59ba37e96..1f11c489c 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1075,9 +1075,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif + if (nint(Sfcprop(nb)%stype(ix)) == 14 .or. int(Sfcprop(nb)%stype(ix)+0.5) <= 0) then + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%stype(ix) = -999.0 + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%lakefrac(ix) = one + endif + endif + if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + if (Sfcprop(nb)%slmsk(ix) == 1 .and. nint(Sfcprop(nb)%stype(ix)) == 14) & + Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then @@ -1127,7 +1137,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%slmsk(ix) = nint(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%stype(ix) <= 0) Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%stype(ix) <= 0 .or. nint(Sfcprop(nb)%stype(ix)) == 14) & + Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then Sfcprop(nb)%oceanfrac(ix) = one Sfcprop(nb)%landfrac(ix) = zero @@ -1140,7 +1151,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0) then + if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & + .and. nint(Sfcprop(nb)%stype(ix)) /= 14) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero From a10fac6d77e5f842a45fca7cd6e533084d33ad2b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 2 Aug 2021 13:01:04 -0400 Subject: [PATCH 181/217] updating FV3GFS_io to add check on soiltype bein less than zero or 14 oven land points --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 16 ++++++++++++++-- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 43c767725..dfacad08e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 43c767725d67ed0d5b0b9dae1ece44ee1983750d +Subproject commit dfacad08eda5d4aa2171faa1fd709a18d909cdd9 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 59ba37e96..1f11c489c 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1075,9 +1075,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif + if (nint(Sfcprop(nb)%stype(ix)) == 14 .or. int(Sfcprop(nb)%stype(ix)+0.5) <= 0) then + Sfcprop(nb)%landfrac(ix) = zero + Sfcprop(nb)%stype(ix) = -999.0 + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%lakefrac(ix) = one + endif + endif + if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) + if (Sfcprop(nb)%slmsk(ix) == 1 .and. nint(Sfcprop(nb)%stype(ix)) == 14) & + Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then @@ -1127,7 +1137,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%slmsk(ix) = nint(Sfcprop(nb)%landfrac(ix)) - if (Sfcprop(nb)%stype(ix) <= 0) Sfcprop(nb)%slmsk(ix) = zero + if (Sfcprop(nb)%stype(ix) <= 0 .or. nint(Sfcprop(nb)%stype(ix)) == 14) & + Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then Sfcprop(nb)%oceanfrac(ix) = one Sfcprop(nb)%landfrac(ix) = zero @@ -1140,7 +1151,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif else - if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0) then + if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & + .and. nint(Sfcprop(nb)%stype(ix)) /= 14) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero Sfcprop(nb)%oceanfrac(ix) = zero From c6028af38edf3822ad4ac039e1ddc4bd646be344 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 9 Aug 2021 23:43:31 +0000 Subject: [PATCH 182/217] removing *_v17_* SDF --- ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml | 94 ------------------ .../suite_FV3_GFS_v17_cpldnsstras_flake.xml | 95 ------------------- .../suite_FV3_GFS_v17_cpldnsstrasnoshal.xml | 91 ------------------ ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml | 95 ------------------- ccpp/suites/suite_FV3_GFS_v17_ras.xml | 93 ------------------ ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml | 94 ------------------ ccpp/suites/suite_FV3_GFS_v17_sas.xml | 94 ------------------ 7 files changed, 656 deletions(-) delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_ras.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml delete mode 100644 ccpp/suites/suite_FV3_GFS_v17_sas.xml diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml deleted file mode 100644 index 3b9eaf588..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras.xml +++ /dev/null @@ -1,94 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - 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 - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - rascnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml deleted file mode 100644 index d15db96b5..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstras_flake.xml +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - 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 - lsm_noah - flake_driver - sfc_nst_pre - sfc_nst - sfc_nst_post - 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 - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - rascnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml deleted file mode 100644 index 47110dfb3..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstrasnoshal.xml +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - 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 - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - rascnv - GFS_DCNV_generic_post - GFS_suite_interstitial_4 - cnvc90 - GFS_MP_generic_pre - gfdl_cloud_microphys - GFS_MP_generic_post - maximum_hourly_diagnostics - - - - - GFS_stochastics - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml b/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml deleted file mode 100644 index 21f71cb74..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_cpldnsstsas.xml +++ /dev/null @@ -1,95 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - 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 - satmedmfvdifq - 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 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras.xml b/ccpp/suites/suite_FV3_GFS_v17_ras.xml deleted file mode 100644 index 631107e0e..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_ras.xml +++ /dev/null @@ -1,93 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - rascnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml b/ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml deleted file mode 100644 index e89083278..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_ras_flake.xml +++ /dev/null @@ -1,94 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - flake_driver - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdifq - GFS_PBL_generic_post - GFS_GWD_generic_pre - cires_ugwp - cires_ugwp_post - GFS_GWD_generic_post - GFS_suite_stateout_update - ozphys_2015 - h2ophys - get_phi_fv3 - GFS_suite_interstitial_3 - GFS_DCNV_generic_pre - rascnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - diff --git a/ccpp/suites/suite_FV3_GFS_v17_sas.xml b/ccpp/suites/suite_FV3_GFS_v17_sas.xml deleted file mode 100644 index 01acf5744..000000000 --- a/ccpp/suites/suite_FV3_GFS_v17_sas.xml +++ /dev/null @@ -1,94 +0,0 @@ - - - - - - - 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 - lsm_noah - sfc_nst_pre - sfc_nst - sfc_nst_post - sfc_sice - GFS_surface_loop_control_part2 - - - - GFS_surface_composites_post - sfc_diag - sfc_diag_post - GFS_surface_generic_post - GFS_PBL_generic_pre - satmedmfvdifq - 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 - GFS_DCNV_generic_pre - samfdeepcnv - GFS_DCNV_generic_post - GFS_SCNV_generic_pre - samfshalcnv - 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 - phys_tend - - - - From 71ae810067ee8a96ce8abd124ec6d4e3d3a62b4d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 10 Aug 2021 00:11:12 +0000 Subject: [PATCH 183/217] some fixes done in cice_alb branch --- ccpp/data/GFS_typedefs.meta | 8 ++++---- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 6 +++--- io/post_regional.F90 | 6 ------ 4 files changed, 8 insertions(+), 14 deletions(-) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 10f27f27b..7b08da46e 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1331,7 +1331,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo) [albdifvis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -1339,7 +1339,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo) [albdirnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -1347,7 +1347,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo) [albdifnir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -1355,7 +1355,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo == .true.) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. flag_for_cice_albedo) [wetness] standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness for lsm diff --git a/ccpp/physics b/ccpp/physics index dd8657756..09655156c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit dd8657756e909ad11c78476f29d91ff953d5ecb9 +Subproject commit 09655156c1dd295932242117da5e9903bdd30ef5 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index b071e291e..adc3c9b03 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1077,7 +1077,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (nint(Sfcprop(nb)%stype(ix)) == 14 .or. int(Sfcprop(nb)%stype(ix)+0.5) <= 0) then Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%stype(ix) = -999.0 + Sfcprop(nb)%stype(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%lakefrac(ix) = one endif @@ -1522,9 +1522,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2o = 18 if (Model%lsm == Model%lsm_ruc) then if (Model%rdlai) then - nvar2r = 19 + nvar2r = 15 else - nvar2r = 18 + nvar2r = 14 endif nvar3 = 5 else diff --git a/io/post_regional.F90 b/io/post_regional.F90 index 6d047fb41..44ea99b2e 100644 --- a/io/post_regional.F90 +++ b/io/post_regional.F90 @@ -296,13 +296,7 @@ subroutine post_getattr_regional(wrt_int_state) else lonstart = nint(lon1*gdsdegr) endif - if( lon2<0 ) then - lonlast = nint((lon2+360.)*gdsdegr) - else - lonlast = nint(lon2*gdsdegr) - endif latstart = nint(lat1*gdsdegr) - latlast = nint(lat2*gdsdegr) truelat1 = nint(stdlat1*gdsdegr) truelat2 = nint(stdlat2*gdsdegr) From 56a810e539c1ae0807642cf524301b4981a98591 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 12 Aug 2021 00:01:38 +0000 Subject: [PATCH 184/217] adding anew suite --- ...te_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml | 95 +++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml new file mode 100644 index 000000000..668cd825d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + GFS_radiation_surface + 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 + noahmpdrv + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From cfd6cdc1a7de1e369617742ac4d7202c41d60911 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 12 Aug 2021 13:07:08 -0400 Subject: [PATCH 185/217] after merging with fv3atm/develop and a minor update to FV3GFS_io.F90 --- io/FV3GFS_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index adc3c9b03..78717cfc1 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1172,7 +1172,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif - if (warm_start) then + if (warm_start .and. Model%kdt > 1) then Sfcprop(nb)%slmsk(ix) = sfc_var2(i,j,1) !--- slmsk endif From 193432ac8141995223f406037ffa93f13ce46d84 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 13 Aug 2021 10:58:18 -0400 Subject: [PATCH 186/217] adding a new SDF --- .../suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml | 95 +++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml new file mode 100644 index 000000000..0f9268de2 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasnoahmp.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + GFS_radiation_surface + 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 + noahmpdrv + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + rascnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From c3b9f4b80687874661f1ce86c3259f0dbceafc64 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 19 Aug 2021 18:36:02 +0000 Subject: [PATCH 187/217] fixing indentation --- ccpp/data/GFS_typedefs.F90 | 8 --- ccpp/physics | 2 +- .../stochastic_physics_wrapper.F90 | 70 +++++++++---------- 3 files changed, 36 insertions(+), 44 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 9bb68da10..d1cbc94ad 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2476,10 +2476,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) if (Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%sncovr_ice (IM)) allocate (Sfcprop%emis_ice (IM)) -! allocate (Sfcprop%albdirvis_ice (IM)) -! allocate (Sfcprop%albdirnir_ice (IM)) -! allocate (Sfcprop%albdifvis_ice (IM)) -! allocate (Sfcprop%albdifnir_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2507,10 +2503,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) if (Model%lsm == Model%lsm_ruc) then Sfcprop%sncovr_ice = clear_val Sfcprop%emis_ice = clear_val -! Sfcprop%albdirvis_ice = clear_val -! Sfcprop%albdirnir_ice = clear_val -! Sfcprop%albdifvis_ice = clear_val -! Sfcprop%albdifnir_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val diff --git a/ccpp/physics b/ccpp/physics index cabe68f4a..3721df156 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit cabe68f4a933f72276c12c557a5d6b4a0d909d7d +Subproject commit 3721df1561514a15b6141a6461d26a33472a3fa7 diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index f0e476d5b..0a4ab220f 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -296,19 +296,19 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) if (GFS_Control%do_ca) then - if(GFS_Control%ca_sgs)then + if(GFS_Control%ca_sgs)then ! Allocate contiguous arrays; copy in as needed - allocate(sst (1:nblks, maxblk)) - allocate(lmsk (1:nblks, maxblk)) - allocate(lake (1:nblks, maxblk)) - allocate(ca_deep_diag(1:nblks, maxblk)) - allocate(ca_turb_diag(1:nblks, maxblk)) - allocate(ca_shal_diag(1:nblks, maxblk)) - allocate(condition (1:nblks, maxblk)) - allocate(ca_deep_cpl (1:nblks, maxblk)) - allocate(ca_turb_cpl (1:nblks, maxblk)) - allocate(ca_shal_cpl (1:nblks, maxblk)) - do nb=1,nblks + allocate(sst (1:nblks, maxblk)) + allocate(lmsk (1:nblks, maxblk)) + allocate(lake (1:nblks, maxblk)) + allocate(ca_deep_diag(1:nblks, maxblk)) + allocate(ca_turb_diag(1:nblks, maxblk)) + allocate(ca_shal_diag(1:nblks, maxblk)) + allocate(condition (1:nblks, maxblk)) + allocate(ca_deep_cpl (1:nblks, maxblk)) + allocate(ca_turb_cpl (1:nblks, maxblk)) + allocate(ca_shal_cpl (1:nblks, maxblk)) + do nb=1,nblks sst (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%tsfco(:) lmsk (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%slmsk(:) lake (nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Sfcprop%lakefrac(:) @@ -316,35 +316,35 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) ca_deep_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_deep(:) ca_turb_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_turb(:) ca_shal_cpl(nb,1:GFS_Control%blksz(nb)) = GFS_Data(nb)%Coupling%ca_shal(:) - enddo - call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & - sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & - ca_shal_diag,Atm(mygrid)%domain_for_coupler,nblks, & - Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & - GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives,GFS_Control%nfracseed, & - GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & - GFS_Control%ca_smooth,GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) + enddo + call cellular_automata_sgs(GFS_Control%kdt,GFS_control%dtf,GFS_control%restart,GFS_Control%first_time_step, & + sst,lmsk,lake,condition,ca_deep_cpl,ca_turb_cpl,ca_shal_cpl,ca_deep_diag,ca_turb_diag, & + ca_shal_diag,Atm(mygrid)%domain_for_coupler,nblks, & + Atm_block%isc,Atm_block%iec,Atm_block%jsc,Atm_block%jec,Atm(mygrid)%npx,Atm(mygrid)%npy, levs, & + GFS_Control%nthresh,GFS_Control%rcell,GFS_Control%nca,GFS_Control%scells,GFS_Control%tlives,GFS_Control%nfracseed, & + GFS_Control%nseed,GFS_Control%ca_global,GFS_Control%ca_sgs,GFS_Control%iseed_ca, & + GFS_Control%ca_smooth,GFS_Control%nspinup,GFS_Control%ca_trigger,Atm_block%blksz(1),GFS_Control%master,GFS_Control%communicator) ! Copy contiguous data back as needed - do nb=1,nblks + do nb=1,nblks GFS_Data(nb)%Intdiag%ca_deep(:) = ca_deep_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Intdiag%ca_turb(:) = ca_turb_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Intdiag%ca_shal(:) = ca_shal_diag(nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_deep(:) = ca_deep_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_turb(:) = ca_turb_cpl (nb,1:GFS_Control%blksz(nb)) GFS_Data(nb)%Coupling%ca_shal(:) = ca_shal_cpl (nb,1:GFS_Control%blksz(nb)) - enddo - deallocate(sst ) - deallocate(lmsk ) - deallocate(lake ) - deallocate(condition ) - deallocate(ca_deep_cpl ) - deallocate(ca_turb_cpl ) - deallocate(ca_shal_cpl ) - deallocate(ca_deep_diag) - deallocate(ca_turb_diag) - deallocate(ca_shal_diag) - endif - if(GFS_Control%ca_global)then + enddo + deallocate(sst ) + deallocate(lmsk ) + deallocate(lake ) + deallocate(condition ) + deallocate(ca_deep_cpl ) + deallocate(ca_turb_cpl ) + deallocate(ca_shal_cpl ) + deallocate(ca_deep_diag) + deallocate(ca_turb_diag) + deallocate(ca_shal_diag) + endif + if(GFS_Control%ca_global)then ! Allocate contiguous arrays; no need to copy in (intent out) allocate(ca1_cpl (1:nblks, maxblk)) allocate(ca2_cpl (1:nblks, maxblk)) @@ -372,7 +372,7 @@ subroutine stochastic_physics_wrapper (GFS_Control, GFS_Data, Atm_block, ierr) deallocate(ca1_diag) deallocate(ca2_diag) deallocate(ca3_diag) - endif + endif endif !do_ca From b50c5b7de6caf64abc480e0be237eb5861e2f41e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 21 Aug 2021 00:30:39 +0000 Subject: [PATCH 188/217] some minot cleanup --- atmos_model.F90 | 12 +-- ccpp/data/GFS_typedefs.F90 | 2 +- ccpp/physics | 2 +- ...te_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml | 95 +++++++++++++++++++ ...suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml | 95 +++++++++++++++++++ .../stochastic_physics_wrapper.F90 | 16 ++-- 6 files changed, 206 insertions(+), 16 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml create mode 100644 ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml diff --git a/atmos_model.F90 b/atmos_model.F90 index 0730a886a..244123785 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -427,9 +427,9 @@ subroutine atmos_timestep_diagnostics(Atmos) if(.not. GFS_control%first_time_step) then pmaxloc = 0.0d0 recvbuf = 0.0d0 - psum = 0.0d0 - pcount = 0.0d0 - maxabs = 0.0d0 + psum = 0.0d0 + pcount = 0.0d0 + maxabs = 0.0d0 ! Put pgr stats in pmaxloc, psum, and pcount: pmaxloc(1) = GFS_Control%tile_num @@ -438,11 +438,11 @@ subroutine atmos_timestep_diagnostics(Atmos) do i=1,count pdiff = GFS_data(nb)%Statein%pgr(i)-GFS_data(nb)%Intdiag%old_pgr(i) adiff = abs(pdiff) - psum = psum+adiff + psum = psum + adiff if(adiff>=maxabs) then maxabs=adiff - pmaxloc(2:3)=(/ ATM_block%index(nb)%ii(i), ATM_block%index(nb)%jj(i) /) - pmaxloc(4:7)=(/ pdiff, GFS_data(nb)%Statein%pgr(i), & + pmaxloc(2:3) = (/ ATM_block%index(nb)%ii(i), ATM_block%index(nb)%jj(i) /) + pmaxloc(4:7) = (/ pdiff, GFS_data(nb)%Statein%pgr(i), & GFS_data(nb)%Grid%xlat(i), GFS_data(nb)%Grid%xlon(i) /) endif enddo diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d1cbc94ad..15f337772 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3677,7 +3677,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & h0facu, h0facs, & !--- cellular automata nca, scells, tlives, nca_g, ncells_g, nlives_g, nfracseed, & - nseed, nseed_g, rcell, do_ca, & + nseed, nseed_g, rcell, do_ca, & ca_sgs, ca_global,iseed_ca,ca_smooth, & nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, & !--- IAU diff --git a/ccpp/physics b/ccpp/physics index 3721df156..915ce6f87 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3721df1561514a15b6141a6461d26a33472a3fa7 +Subproject commit 915ce6f87e0571b0feb1cc7675a540e4320a4460 diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml new file mode 100644 index 000000000..d0bc56c9e --- /dev/null +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + GFS_radiation_surface + 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 + noahmpdrv + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml new file mode 100644 index 000000000..6b6dd9c2d --- /dev/null +++ b/ccpp/suites/suite_FV3_GFSv17alpha_cpldnsstsas_ugwp.xml @@ -0,0 +1,95 @@ + + + + + + + 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 + GFS_radiation_surface + 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_nst_pre + sfc_nst + sfc_nst_post + 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 + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + ugwpv1_gsldrag + ugwpv1_gsldrag_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/stochastic_physics/stochastic_physics_wrapper.F90 b/stochastic_physics/stochastic_physics_wrapper.F90 index 0a4ab220f..ae45e7cfb 100644 --- a/stochastic_physics/stochastic_physics_wrapper.F90 +++ b/stochastic_physics/stochastic_physics_wrapper.F90 @@ -36,14 +36,14 @@ module stochastic_physics_wrapper_mod real(kind=kind_phys), dimension(:,:), allocatable, save :: stype ! For cellular automata - real(kind=kind_phys), dimension(:,:), allocatable, save :: sst - real(kind=kind_phys), dimension(:,:), allocatable, save :: lmsk - real(kind=kind_phys), dimension(:,:), allocatable, save :: lake - real(kind=kind_phys), dimension(:,:), allocatable, save :: condition - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca_deep_cpl, ca_turb_cpl, ca_shal_cpl - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca_deep_diag,ca_turb_diag,ca_shal_diag - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca1_cpl, ca2_cpl, ca3_cpl - real(kind=kind_phys), dimension(:,:), allocatable, save :: ca1_diag,ca2_diag,ca3_diag + real(kind=kind_phys), dimension(:,:), allocatable :: sst + real(kind=kind_phys), dimension(:,:), allocatable :: lmsk + real(kind=kind_phys), dimension(:,:), allocatable :: lake + real(kind=kind_phys), dimension(:,:), allocatable :: condition + real(kind=kind_phys), dimension(:,:), allocatable :: ca_deep_cpl, ca_turb_cpl, ca_shal_cpl + real(kind=kind_phys), dimension(:,:), allocatable :: ca_deep_diag,ca_turb_diag,ca_shal_diag + real(kind=kind_phys), dimension(:,:), allocatable :: ca1_cpl, ca2_cpl, ca3_cpl + real(kind=kind_phys), dimension(:,:), allocatable :: ca1_diag,ca2_diag,ca3_diag !---------------- From 05b00374abaf43c4317eb3d415dc4fef3127bb34 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 3 Sep 2021 02:02:15 +0000 Subject: [PATCH 189/217] fix a bug in post_gfs --- io/post_gfs.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 7f6c746da..c9c87f5e6 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -60,6 +60,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & real,dimension(komax),save :: po, th, pv logical :: Log_runpost character(255) :: post_fname*255 + real * 4, dimension(komax) :: th4, pv4 integer,save :: iostatusD3D=-1 ! @@ -183,11 +184,15 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & IEOF = 0 npset = 0 icount_calmict = 0 + th4(1:kth) = th(1:kth) + pv4(1:kpv) = pv(1:kpv) do while( IEOF == 0) ! if(grib == "grib2") then npset = npset + 1 - call set_outflds(kth,th,kpv,pv) + if (mype == 0) write(0,*)' in post_gfs kth=',kth,' th=',th(1:kth),& + ' kpv=',kpv,' pv=',pv(1:kpv) + call set_outflds(kth,th4,kpv,pv4) if(allocated(datapd))deallocate(datapd) allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) !$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) From c2b71996ad68535b729c9ba4b8a2a221bd56a88c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 4 Sep 2021 01:49:05 +0000 Subject: [PATCH 190/217] some additional fix I guess --- io/post_gfs.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 9570bf114..d2d4455fb 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -192,6 +192,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & if(grib == "grib2") then npset = npset + 1 call set_outflds(kth,th4,kpv,pv4) +! call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) !$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) @@ -205,7 +206,8 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & call get_postfilename(post_fname) if (mype==0) write(0,*)'post_fname=',trim(post_fname) ! - if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) +! if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) + if ( ieof == 0) call process(kth,kpv,th4(1:kth),pv4(1:kpv),iostatusD3D) ! call mpi_barrier(mpicomp,ierr) call gribit2(post_fname) From 239fa2df121dfe7de85ff8fda4bafdfa681801d2 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 4 Sep 2021 20:08:17 -0400 Subject: [PATCH 191/217] some blank changes in post_gfs --- io/post_gfs.F90 | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index d2d4455fb..436d9f5bd 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -356,7 +356,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & cfrach, cfracl, cfracm, avgcfrach, qshltr, & avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, & + bgroff, rlwin, & rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & rswinc, rswout, aswin, auvbin, auvbinc, aswout, & aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & @@ -472,8 +472,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (ip1 > im) ip1 = ip1 - im dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH - end do - end do + enddo + enddo ! if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) do i=1,lm+1 @@ -485,8 +485,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) - end do - end do + enddo + enddo ! ! GFS does not output PD pt = ak5(1) @@ -683,16 +683,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! ! get inital date - sdat(1) = wrt_int_state%idate(2) !month - sdat(2) = wrt_int_state%idate(3) !day - sdat(3) = wrt_int_state%idate(1) !year - ihrst = wrt_int_state%idate(4) !hour + sdat(1) = wrt_int_state%idate(2) !month + sdat(2) = wrt_int_state%idate(3) !day + sdat(3) = wrt_int_state%idate(1) !year + ihrst = wrt_int_state%idate(4) !hour - idat(1) = wrt_int_state%fdate(2) - idat(2) = wrt_int_state%fdate(3) - idat(3) = wrt_int_state%fdate(1) - idat(4) = wrt_int_state%fdate(4) - idat(5) = wrt_int_state%fdate(5) + idat(1) = wrt_int_state%fdate(2) + idat(2) = wrt_int_state%fdate(3) + idat(3) = wrt_int_state%fdate(1) + idat(4) = wrt_int_state%fdate(4) + idat(5) = wrt_int_state%fdate(5) ! if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst ! CALL W3DIFDAT(JDATE,IDATE,0,RINC) @@ -725,7 +725,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !----------------------------------------------------------------------------- ! foundland = .false. - foundice = .false. + foundice = .false. get_lsmsk: do ibdl=1, wrt_int_state%FBCount ! find lans sea mask @@ -2541,11 +2541,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(pbot(i,j) >= pmid(i,j,l)) then hbot(i,j) = l exit - end if - end do - end if - end do - end do + endif + enddo + endif + enddo + enddo ! generate look up table for lifted parcel calculations thl = 210. @@ -2567,7 +2567,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(l) shared(lsm,alsl,spl) do l = 1,lsm alsl(l) = log(spl(l)) - end do + enddo ! ! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) !!! above is fv3 change From b176a23e4913efe8b37ae76f91025bc4d3b76dac Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 15 Sep 2021 01:47:48 +0000 Subject: [PATCH 192/217] testing assign_import before ca --- atmos_model.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index abf0d68bb..382e51367 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -261,6 +261,10 @@ subroutine update_atmos_radiation_physics (Atmos) call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') +!--- if coupled, assign coupled fields + call assign_importdata(jdat(:),rc) + if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') + if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then !--- call stochastic physics pattern generation / cellular automata @@ -268,10 +272,6 @@ subroutine update_atmos_radiation_physics (Atmos) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') endif -!--- if coupled, assign coupled fields - call assign_importdata(jdat(:),rc) - if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') - ! Calculate total non-physics tendencies by substracting old GFS Stateout ! variables from new/updated GFS Statein variables (gives the tendencies ! due to anything else than physics) From f466f3a91ec0ad8ed82c05891992bf71d8bc6e67 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 16 Sep 2021 11:23:36 +0000 Subject: [PATCH 193/217] removing interstitial land and ice emissivities --- ccpp/data/GFS_typedefs.F90 | 22 ++++++++++++---------- ccpp/data/GFS_typedefs.meta | 14 -------------- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 2 +- 4 files changed, 14 insertions(+), 26 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index df87c4c87..72fc827e2 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2031,8 +2031,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: save_v(:,:) => null() !< real (kind=kind_phys), pointer :: sbsno(:) => null() !< type (cmpfsw_type), pointer :: scmpsw(:) => null() !< - real (kind=kind_phys), pointer :: semis_ice(:) => null() !< - real (kind=kind_phys), pointer :: semis_land(:) => null() !< +! real (kind=kind_phys), pointer :: semis_ice(:) => null() !< +! real (kind=kind_phys), pointer :: semis_land(:) => null() !< real (kind=kind_phys), pointer :: semis_water(:) => null() !< real (kind=kind_phys), pointer :: sfcalb(:,:) => null() !< real (kind=kind_phys), pointer :: sigma(:) => null() !< @@ -2386,6 +2386,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%albdifvis_lnd (IM)) allocate(Sfcprop%albdifnir_lnd (IM)) allocate (Sfcprop%emis_lnd (IM)) + allocate (Sfcprop%emis_ice (IM)) Sfcprop%slmsk = clear_val Sfcprop%oceanfrac = clear_val @@ -2413,6 +2414,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%albdifvis_lnd = clear_val Sfcprop%albdifnir_lnd = clear_val Sfcprop%emis_lnd = clear_val + Sfcprop%emis_ice = clear_val !--- In (radiation only) allocate (Sfcprop%snoalb (IM)) @@ -2476,7 +2478,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) endif if (Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%sncovr_ice (IM)) - allocate (Sfcprop%emis_ice (IM)) +! allocate (Sfcprop%emis_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2503,7 +2505,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) endif if (Model%lsm == Model%lsm_ruc) then Sfcprop%sncovr_ice = clear_val - Sfcprop%emis_ice = clear_val +! Sfcprop%emis_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val @@ -7118,8 +7120,8 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%save_v (IM,Model%levs)) allocate (Interstitial%sbsno (IM)) allocate (Interstitial%scmpsw (IM)) - allocate (Interstitial%semis_ice (IM)) - allocate (Interstitial%semis_land (IM)) +! allocate (Interstitial%semis_ice (IM)) +! allocate (Interstitial%semis_land (IM)) allocate (Interstitial%semis_water (IM)) allocate (Interstitial%sfcalb (IM,NF_ALBD)) allocate (Interstitial%sigma (IM)) @@ -7855,8 +7857,8 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%save_u = clear_val Interstitial%save_v = clear_val Interstitial%sbsno = clear_val - Interstitial%semis_ice = clear_val - Interstitial%semis_land = clear_val +! Interstitial%semis_ice = clear_val +! Interstitial%semis_land = clear_val Interstitial%semis_water = clear_val Interstitial%sigma = clear_val Interstitial%sigmaf = clear_val @@ -8239,8 +8241,8 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%scmpsw%nirdf ) = ', sum(Interstitial%scmpsw%nirdf ) write (0,*) 'sum(Interstitial%scmpsw%visbm ) = ', sum(Interstitial%scmpsw%visbm ) write (0,*) 'sum(Interstitial%scmpsw%visdf ) = ', sum(Interstitial%scmpsw%visdf ) - write (0,*) 'sum(Interstitial%semis_ice ) = ', sum(Interstitial%semis_ice ) - write (0,*) 'sum(Interstitial%semis_land ) = ', sum(Interstitial%semis_land ) +! write (0,*) 'sum(Interstitial%semis_ice ) = ', sum(Interstitial%semis_ice ) +! write (0,*) 'sum(Interstitial%semis_land ) = ', sum(Interstitial%semis_land ) write (0,*) 'sum(Interstitial%semis_water ) = ', sum(Interstitial%semis_water ) write (0,*) 'sum(Interstitial%sfcalb ) = ', sum(Interstitial%sfcalb ) write (0,*) 'sum(Interstitial%sigma ) = ', sum(Interstitial%sigma ) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index c0b386cac..5a4d86cbd 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -8220,20 +8220,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[semis_land] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys -[semis_ice] - standard_name = surface_longwave_emissivity_over_ice_interstitial - long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [ep1d] standard_name = surface_upward_potential_latent_heat_flux long_name = surface upward potential latent heat flux diff --git a/ccpp/physics b/ccpp/physics index 252313dfc..2c6f85a33 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 252313dfc56630b23200f35237da354ef09d8bec +Subproject commit 2c6f85a339a818a97d0c1c61b51a73ebf779ffb0 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index b94f20d43..6c046d598 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1169,7 +1169,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%albdirnir_lnd(ix) = sfc_var2(i,j,41) Sfcprop(nb)%albdifvis_lnd(ix) = sfc_var2(i,j,42) Sfcprop(nb)%albdifnir_lnd(ix) = sfc_var2(i,j,43) - Sfcprop(nb)%emis_lnd(ix) = sfc_var2(i,j,44) + Sfcprop(nb)%emis_lnd(ix) = sfc_var2(i,j,44) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,45) Sfcprop(nb)%albdifvis_ice(ix) = sfc_var2(i,j,46) From a63f49c5ae3b03a65f6a011c89962b97b2a60da8 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 17 Sep 2021 17:55:23 +0000 Subject: [PATCH 194/217] improve treatment of emissivity and remove related unnecessary interstitial variables and remove some commented lines --- ccpp/data/GFS_typedefs.F90 | 22 +++------------------- ccpp/physics | 2 +- 2 files changed, 4 insertions(+), 20 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 72fc827e2..b10912f52 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2031,8 +2031,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: save_v(:,:) => null() !< real (kind=kind_phys), pointer :: sbsno(:) => null() !< type (cmpfsw_type), pointer :: scmpsw(:) => null() !< -! real (kind=kind_phys), pointer :: semis_ice(:) => null() !< -! real (kind=kind_phys), pointer :: semis_land(:) => null() !< real (kind=kind_phys), pointer :: semis_water(:) => null() !< real (kind=kind_phys), pointer :: sfcalb(:,:) => null() !< real (kind=kind_phys), pointer :: sigma(:) => null() !< @@ -2046,9 +2044,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< -! real (kind=kind_phys), pointer :: snowd_land(:) => null() !< real (kind=kind_phys), pointer :: snowd_land_save(:) => null() !< -! real (kind=kind_phys), pointer :: snowd_water(:) => null() !< real (kind=kind_phys), pointer :: snow_depth(:) => null() !< real (kind=kind_phys), pointer :: snohf(:) => null() !< real (kind=kind_phys), pointer :: snohf_snow(:) => null() !< @@ -2478,7 +2474,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) endif if (Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%sncovr_ice (IM)) -! allocate (Sfcprop%emis_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2504,10 +2499,9 @@ subroutine sfcprop_create (Sfcprop, IM, Model) ! Sfcprop%sfalb_ice = clear_val endif if (Model%lsm == Model%lsm_ruc) then - Sfcprop%sncovr_ice = clear_val -! Sfcprop%emis_ice = clear_val - Sfcprop%sfalb_lnd = clear_val - Sfcprop%sfalb_ice = clear_val + Sfcprop%sncovr_ice = clear_val + Sfcprop%sfalb_lnd = clear_val + Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val endif Sfcprop%canopy = clear_val @@ -7120,8 +7114,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%save_v (IM,Model%levs)) allocate (Interstitial%sbsno (IM)) allocate (Interstitial%scmpsw (IM)) -! allocate (Interstitial%semis_ice (IM)) -! allocate (Interstitial%semis_land (IM)) allocate (Interstitial%semis_water (IM)) allocate (Interstitial%sfcalb (IM,NF_ALBD)) allocate (Interstitial%sigma (IM)) @@ -7131,8 +7123,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%slopetype (IM)) allocate (Interstitial%snowc (IM)) allocate (Interstitial%snowd_ice (IM)) -! allocate (Interstitial%snowd_land (IM)) -! allocate (Interstitial%snowd_water (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) allocate (Interstitial%soiltype (IM)) @@ -7857,8 +7847,6 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%save_u = clear_val Interstitial%save_v = clear_val Interstitial%sbsno = clear_val -! Interstitial%semis_ice = clear_val -! Interstitial%semis_land = clear_val Interstitial%semis_water = clear_val Interstitial%sigma = clear_val Interstitial%sigmaf = clear_val @@ -7867,8 +7855,6 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%slopetype = 0 Interstitial%snowc = clear_val Interstitial%snowd_ice = huge -! Interstitial%snowd_land = huge -! Interstitial%snowd_water = huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val Interstitial%soiltype = 0 @@ -8241,8 +8227,6 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%scmpsw%nirdf ) = ', sum(Interstitial%scmpsw%nirdf ) write (0,*) 'sum(Interstitial%scmpsw%visbm ) = ', sum(Interstitial%scmpsw%visbm ) write (0,*) 'sum(Interstitial%scmpsw%visdf ) = ', sum(Interstitial%scmpsw%visdf ) -! write (0,*) 'sum(Interstitial%semis_ice ) = ', sum(Interstitial%semis_ice ) -! write (0,*) 'sum(Interstitial%semis_land ) = ', sum(Interstitial%semis_land ) write (0,*) 'sum(Interstitial%semis_water ) = ', sum(Interstitial%semis_water ) write (0,*) 'sum(Interstitial%sfcalb ) = ', sum(Interstitial%sfcalb ) write (0,*) 'sum(Interstitial%sigma ) = ', sum(Interstitial%sigma ) diff --git a/ccpp/physics b/ccpp/physics index 7d169b331..12d85af52 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7d169b33196e8207f5bfad8ff291f9ad4dbdf4e3 +Subproject commit 12d85af52c95ed36e52d91a5f9549e80a4a8d8cb From f26ccec99fe568fc69e0e99ef10d7230aef30e05 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 21 Sep 2021 16:51:30 +0000 Subject: [PATCH 195/217] reverting post_gfs to dev version and pointing dynamics to dev version --- .gitmodules | 6 +- atmos_cubed_sphere | 2 +- io/post_gfs.F90 | 979 +++++++++++++++++++++------------------------ 3 files changed, 471 insertions(+), 516 deletions(-) diff --git a/.gitmodules b/.gitmodules index 444811199..a9f576a6f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/SMoorthi-emc/GFDL_atmos_cubed_sphere - branch = SM_Jul232021 + url = https://github.com/NOAH-GFDL/GFDL_atmos_cubed_sphere + branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Jul302021 + branch = SM_Sept21_PR diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 098671b7e..86177e14c 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 098671b7e1b8bd850c6bd6704594a983222b1956 +Subproject commit 86177e14cdf60ce53fc6ec15829a8876db0c7445 diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 436d9f5bd..105172a86 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -30,7 +30,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & npset,grib,gocart_on,icount_calmict, jsta, & - jend,im, nsoil, filenameflat, me + jend,im, nsoil, filenameflat use gridspec_mod, only : maptype, gridtype use grib2_module, only : gribit2,num_pset,nrecout,first_grbtbl use xml_perl_data,only : paramset @@ -60,7 +60,6 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & real,dimension(komax),save :: po, th, pv logical :: Log_runpost character(255) :: post_fname*255 - real * 4, dimension(komax), save :: th4, pv4 integer,save :: iostatusD3D=-1 ! @@ -83,7 +82,6 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection maptype = wrt_int_state%post_maptype nbdl = wrt_int_state%FBCount - me = mype - lead_write if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct @@ -109,29 +107,25 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_nlunit, & wrt_int_state%post_namelist) - - th4(1:kth) = th(1:kth) - pv4(1:kpv) = pv(1:kpv) ! !----------------------------------------------------------------------- !*** allocate post variables !----------------------------------------------------------------------- ! ! if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & -! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & -! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & +! wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & +! wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & ! 'jstagrp=',jstagrp,'jendgrp=',jendgrp - - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp) + call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & + wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. + log_postalct = .true. + first_grbtbl = .true. read_postcntrl = .true. ! ENDIF @@ -144,16 +138,16 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ifmin = mynfmin if (ifhr == 0 ) ifmin = 0 if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile = .false. - setvar_sfcfile = .false. + setvar_atmfile=.false. + setvar_sfcfile=.false. call set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) + setvar_sfcfile) ! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & ! 'setvar_sfcfile=',setvar_sfcfile ! if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 need to call microinit only for Ferrier microphysics +! 20190807 no need to call microinit for GFDLMP ! call MICROINIT ! if(grib=="grib2" .and. read_postcntrl) then @@ -164,7 +158,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & else if(ifhr > 0) then filenameflat = 'postxconfig-NT.txt' if(associated(paramset)) then - if(size(paramset)>0) then + if( size(paramset)>0) then do i=1,size(paramset) if (associated(paramset(i)%param)) then if (size(paramset(i)%param)>0) then @@ -191,8 +185,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & ! if(grib == "grib2") then npset = npset + 1 - call set_outflds(kth,th4,kpv,pv4) -! call set_outflds(kth,th,kpv,pv) + call set_outflds(kth,th,kpv,pv) if(allocated(datapd))deallocate(datapd) allocate(datapd(wrt_int_state%im,jte-jts+1,nrecout+100)) !$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd) @@ -206,8 +199,7 @@ subroutine post_run_gfs(wrt_int_state,mypei,mpicomp,lead_write, & call get_postfilename(post_fname) if (mype==0) write(0,*)'post_fname=',trim(post_fname) ! -! if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) - if ( ieof == 0) call process(kth,kpv,th4(1:kth),pv4(1:kpv),iostatusD3D) + if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) ! call mpi_barrier(mpicomp,ierr) call gribit2(post_fname) @@ -256,62 +248,66 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out ! aklen=0. do i=1, attCount - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & - typekind=typekind, itemCount=n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__,file=__FILE__))return ! bail out if (typekind==ESMF_TYPEKIND_I4 ) then - if(n == 1) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varival, rc=rc) - if (trim(attName) == 'ncnsto') wrt_int_state%ntrac = varival - if (trim(attName) == 'ncld') wrt_int_state%ncld = varival - if (trim(attName) == 'nsoil') wrt_int_state%nsoil = varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero = varival - if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics = varival + name=trim(attName), value=varival, rc=rc) + if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival + if (trim(attName) == 'ncld') wrt_int_state%ncld=varival + if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival + if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif - else if (typekind == ESMF_TYPEKIND_R4) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R4) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr4val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + name=trim(attName), value=varr4val, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr4val endif - else if(n > 1) then + else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 - else if(trim(attName) == "bk") then + else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif endif - else if (typekind == ESMF_TYPEKIND_R8) then - if(n == 1) then + else if (typekind==ESMF_TYPEKIND_R8) then + if(n==1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val endif - else if(n > 1) then - if(trim(attName) == "ak") then + else if(n>1) then + if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) + name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) @@ -347,8 +343,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, & - qqnw, qqni, qqnr, qqns, qqng, qqnwfa, qqnifa + pint, exch_h, ref_10cm, qqni,qqnr,qqnwfa,qqnifa use vrbls2d, only: f, pd, sigt4, fis, pblh, ustar, z0, ths, qs, twbs,& qwbs, avgcprate, cprate, avgprec, prec, lspa, sno,& cldefi, th10, q10, tshltr, pshltr, tshltr, albase,& @@ -356,7 +351,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & cfrach, cfracl, cfracm, avgcfrach, qshltr, & avgcfracl, avgcfracm, cnvcfr, islope, cmc, grnflx,& vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, & + bgroff, rlwin, & rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, & rswinc, rswout, aswin, auvbin, auvbinc, aswout, & aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcux, & @@ -376,11 +371,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & use soil, only: sldpth, sh2o, smc, stc use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, & - lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & - tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & + lsm, pt, imp_physics, spval, mpi_comm_comp, gdsdegr, & + tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, theat, & ardlw, ardsw, asrfc, avrain, avcnvc, iSF_SURFACE_PHYSICS,& - td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & - alsl, spl, ihrst + td3d, idat, sdat, ifhr, ifmin, dt, nphs, dtq2, pt_tbl, & + alsl, spl, ihrst use params_mod, only: erad, dtr, capa, p1000 use gridspec_mod,only: latstart, latlast, lonstart, lonlast, cenlon, cenlat use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, & @@ -405,12 +400,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! !----------------------------------------------------------------------- ! - integer i, ip1, j, l, ll, k, n, iret, ibdl, rc, kstart, kend + integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer ista,iend,fieldDimCount,gridDimCount,ncount_field integer jdate(8) logical foundland, foundice, found real(4) rinc(5) - real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp, dtq2001 + real tlmh,RADI,TMP,ES,TV,RHOAIR,tem,tstart,dtp real, dimension(:),allocatable :: ak5, bk5 real(4),dimension(:,:),pointer :: arrayr42d real(8),dimension(:,:),pointer :: arrayr82d @@ -472,8 +467,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (ip1 > im) ip1 = ip1 - im dx(i,j) = erad*cos(gdlat(i,j)*dtr)*(gdlon(ip1,j)-gdlon(i,j))*dtr dy(i,j) = erad*(gdlat(i,j)-gdlat(i,j+1))*dtr ! like A*DPH - enddo - enddo + end do + end do ! if(.not. allocated(ak5)) allocate(ak5(lm+1),bk5(lm+1)) do i=1,lm+1 @@ -485,11 +480,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im f(I,J) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi) - enddo - enddo + end do + end do ! ! GFS does not output PD - pt = ak5(1) + pt = ak5(1) ! GFS may not have model derived radar ref. ! TKE @@ -500,7 +495,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & do j=jsta,jend do i=1,im ref_10cm(i,j,l) = SPVAL - q2(i,j,l) = SPVAL + q2(i,j,l) = SPVAL cfr(i,j,l) = SPVAL enddo enddo @@ -512,10 +507,10 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,qs,twbs,qwbs,ths) do j=jsta,jend do i=1,im - qs(i,j) = SPVAL + qs(i,j) = SPVAL twbs(i,j) = SPVAL qwbs(i,j) = SPVAL - ths(i,j) = SPVAL + ths(i,j) = SPVAL enddo enddo @@ -523,7 +518,6 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & dtq2 = wrt_int_state%dtp nphs = 2. dt = dtq2/nphs - dtq2001 = dtq2*0.001 ! ! GFS does not have convective cloud efficiency ! similated precip @@ -531,16 +525,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! 10 m humidity ! snow free albedo !$omp parallel do default(none), private(i,j), shared(jsta,jend,im,spval), & -!$omp& shared(cldefi,lspa,th10,q10,albase,cprate) +!$omp& shared(cldefi,lspa,th10,q10,albase) do j=jsta,jend do i=1,im cldefi(i,j) = SPVAL - lspa(i,j) = SPVAL - th10(i,j) = SPVAL - q10(i,j) = SPVAL + lspa(i,j) = SPVAL + th10(i,j) = SPVAL + q10(i,j) = SPVAL albase(i,j) = SPVAL + enddo + enddo - cprate(i,j) = 0.0 ! GFS does not have convective precip ???? +! GFS does not have convective precip +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,cprate) + do j=jsta,jend + do i=1,im + cprate(i,j) = 0. enddo enddo @@ -615,7 +615,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp& shared(rlwtt,rswtt,tcucn,tcucns,train) do j=jsta_2l,jend_2u do i=1,im - rlwtt(i,j,l) = spval + rlwtt(i,j,l) = spval rswtt(i,j,l) = spval tcucn(i,j,l) = spval tcucns(i,j,l) = spval @@ -683,16 +683,16 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo ! ! get inital date - sdat(1) = wrt_int_state%idate(2) !month - sdat(2) = wrt_int_state%idate(3) !day - sdat(3) = wrt_int_state%idate(1) !year - ihrst = wrt_int_state%idate(4) !hour + sdat(1) = wrt_int_state%idate(2) !month + sdat(2) = wrt_int_state%idate(3) !day + sdat(3) = wrt_int_state%idate(1) !year + ihrst = wrt_int_state%idate(4) !hour - idat(1) = wrt_int_state%fdate(2) - idat(2) = wrt_int_state%fdate(3) - idat(3) = wrt_int_state%fdate(1) - idat(4) = wrt_int_state%fdate(4) - idat(5) = wrt_int_state%fdate(5) + idat(1) = wrt_int_state%fdate(2) + idat(2) = wrt_int_state%fdate(3) + idat(3) = wrt_int_state%fdate(1) + idat(4) = wrt_int_state%fdate(4) + idat(5) = wrt_int_state%fdate(5) ! if(mype==0) print *,'idat=',idat,'sdat=',sdat,'ihrst=',ihrst ! CALL W3DIFDAT(JDATE,IDATE,0,RINC) @@ -725,25 +725,25 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !----------------------------------------------------------------------------- ! foundland = .false. - foundice = .false. + foundice = .false. get_lsmsk: do ibdl=1, wrt_int_state%FBCount ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'land, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'land',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) + !$omp parallel do default(none),private(i,j),shared(jsta,jend,ista,iend,spval,arrayr42d,sm) do j=jsta, jend do i=ista, iend if (arrayr42d(i,j) /= spval) sm(i,j) = 1.- arrayr42d(i,j) @@ -755,17 +755,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! find ice fraction found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',isPresent=found, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'ibdl=',ibdl,'ice, found=',found if (found) then call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),'icec',field=theField, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_FieldGet(theField, localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ista = lbound(arrayr42d,1) iend = ubound(arrayr42d,1) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,sm) do j=jsta, jend do i=ista, iend sice(i,j) = arrayr42d(i,j) @@ -777,8 +779,9 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo get_lsmsk if (.not.foundland .or. .not.foundice) then - rc = 999 - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + rc=999 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out endif if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount ! @@ -786,27 +789,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & -! ista,iend,'jdim=',jsta,jend +! ista,iend,'jdim=',jsta,jend call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & - fieldCount=ncount_field, name=wrtFBName,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + fieldCount=ncount_field, name=wrtFBName,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, allocate fcstField,ibdl=',ibdl,'count=',ncount_field,'wrtFBname=',trim(wrtFBName) allocate(fcstField(ncount_field)) call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), & - fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + fieldList=fcstField, itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl, 'nfield=',ncount_field - do n=1, ncount_field ! call ESMF_FieldGet(fcstField(n),typekind=typekind, name=fieldname, & - dimCount=fieldDimCount,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + dimCount=fieldDimCount,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out if (index(trim(fieldname),"vector") >0) cycle ! !** for 2D fields @@ -814,14 +819,14 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr42d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr82d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate( arrayr42d(ista:iend,jsta:jend)) -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,arrayr82d) do j=jsta, jend do i=ista, iend arrayr42d(i,j) = arrayr82d(i,j) @@ -830,18 +835,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! Terrain height (*G later) - if(trim(fieldname) == 'hgtsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) + if(trim(fieldname)=='hgtsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,fis,arrayr42d) do j=jsta,jend do i=ista, iend - fis(i,j) = arrayr42d(i,j) + fis(i,j)=arrayr42d(i,j) enddo enddo endif ! Surface pressure ! if(trim(fieldname)=='pressfc') then -!!$omp parallel do private(i,j) +! !$omp parallel do private(i,j) ! do j=jsta,jend ! do i=ista, iend ! pint(i,j,lp1)=arrayr42d(i,j) @@ -850,38 +855,38 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! endif ! PBL height using nemsio - if(trim(fieldname) == 'hpbl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) + if(trim(fieldname)=='hpbl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pblh,arrayr42d) do j=jsta,jend do i=ista, iend - pblh(i,j) = arrayr42d(i,j) + pblh(i,j)=arrayr42d(i,j) enddo enddo endif ! frictional velocity - if(trim(fieldname) == 'fricv') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) + if(trim(fieldname)=='fricv') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d) do j=jsta,jend do i=ista, iend - ustar(i,j) = arrayr42d(i,j) + ustar(i,j)=arrayr42d(i,j) enddo enddo endif ! roughness length - if(trim(fieldname) == 'sfcr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) + if(trim(fieldname)=='sfcr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,z0,arrayr42d) do j=jsta,jend do i=ista, iend - z0(i,j) = arrayr42d(i,j) + z0(i,j)=arrayr42d(i,j) enddo enddo endif ! sfc exchange coeff - if(trim(fieldname) == 'sfexc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) + if(trim(fieldname)=='sfexc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcexc,arrayr42d) do j=jsta,jend do i=ista, iend sfcexc(i,j)=arrayr42d(i,j) @@ -890,18 +895,18 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! aerodynamic conductance - if(trim(fieldname) == 'acond') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) + if(trim(fieldname)=='acond') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acond,arrayr42d) do j=jsta,jend do i=ista, iend - acond(i,j) = arrayr42d(i,j) + acond(i,j)=arrayr42d(i,j) enddo enddo endif ! surface potential T - if(trim(fieldname) == 'tmpsfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) + if(trim(fieldname)=='tmpsfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ths) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -912,114 +917,114 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! convective precip in m per physics time step - if(trim(fieldname) == 'cpratb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate) + if(trim(fieldname)=='cpratb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) & - avgcprate(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate(i,j) = arrayr42d(i,j) * (dtq2*0.001) enddo enddo endif ! continuous bucket convective precip in m per physics time step - if(trim(fieldname) =='cprat_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgcprate_cont) + if(trim(fieldname)=='cprat_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgcprate_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgcprate_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgcprate_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged bucketed precip rate - if(trim(fieldname) == 'prateb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec) + if(trim(fieldname)=='prateb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec(i,j) = arrayr42d(i,j) * dtq2001 + avgprec(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! time averaged continuous precip rate in m per physics time step - if(trim(fieldname) == 'prate_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,arrayr42d,avgprec_cont) + if(trim(fieldname)=='prate_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,arrayr42d,avgprec_cont) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - avgprec_cont(i,j) = arrayr42d(i,j) * dtq2001 + avgprec_cont(i,j) = arrayr42d(i,j) * (dtq2*0.001) endif enddo enddo endif ! precip rate in m per physics time step - if(trim(fieldname) == 'tprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,prec) + if(trim(fieldname)=='tprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,prec) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - prec(i,j) = arrayr42d(i,j) * (dtq2001 * 1000./dtp) + prec(i,j) = arrayr42d(i,j) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! convective precip rate in m per physics time step - if(trim(fieldname) == 'cnvprcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2001,dtp,arrayr42d,cprate) + if(trim(fieldname)=='cnvprcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,dtq2,dtp,arrayr42d,cprate) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then - cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2001 * 1000./dtp) + cprate(i,j) = max(0.,arrayr42d(i,j)) * (dtq2*0.001) * 1000./dtp endif enddo enddo endif ! inst snow water eqivalent - if(trim(fieldname) == 'weasd') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) + if(trim(fieldname)=='weasd') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sno,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend sno(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) sno(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j)==0.)sno(i,j) = spval enddo enddo endif ! ave snow cover - if(trim(fieldname) == 'snowc_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) + if(trim(fieldname)=='snowc_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snoavg,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend snoavg(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) snoavg(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j) = spval if (snoavg(i,j) /= spval) snoavg(i,j) = snoavg(i,j)/100. enddo enddo endif ! snow depth in mm - if(trim(fieldname) == 'snod') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) + if(trim(fieldname)=='snod') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,si,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend si(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) si(i,j)=spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 enddo enddo endif ! 2m potential T (computed later) - if(trim(fieldname) == 'tmp2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) + if(trim(fieldname)=='tmp2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,tshltr,arrayr42d) do j=jsta,jend do i=ista, iend tshltr(i,j) = arrayr42d(i,j) @@ -1028,8 +1033,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! surface potential T - if(trim(fieldname) == 'spfh2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) + if(trim(fieldname)=='spfh2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,qshltr,arrayr42d) do j=jsta,jend do i=ista, iend qshltr(i,j) = arrayr42d(i,j) @@ -1038,8 +1043,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! mid day avg albedo in fraction - if(trim(fieldname) == 'albdo_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) + if(trim(fieldname)=='albdo_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgalbedo,arrayr42d) do j=jsta,jend do i=ista, iend avgalbedo(i,j) = arrayr42d(i,j) @@ -1051,8 +1056,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'tcdc_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) + if(trim(fieldname)=='tcdc_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgtcdc,arrayr42d) do j=jsta,jend do i=ista, iend avgtcdc(i,j) = arrayr42d(i,j) @@ -1064,8 +1069,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! maximum snow albedo in fraction - if(trim(fieldname) == 'snoalb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) + if(trim(fieldname)=='snoalb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,mxsnal,arrayr42d) do j=jsta,jend do i=ista, iend mxsnal(i,j) = arrayr42d(i,j) @@ -1077,8 +1082,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave high cloud fraction - if(trim(fieldname) == 'tcdc_avehcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) + if(trim(fieldname)=='tcdc_avehcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfrach,arrayr42d) do j=jsta,jend do i=ista, iend avgcfrach(i,j) = arrayr42d(i,j) @@ -1090,8 +1095,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave low cloud fraction - if(trim(fieldname) == 'tcdc_avelcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) + if(trim(fieldname)=='tcdc_avelcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracl,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracl(i,j) = arrayr42d(i,j) @@ -1103,8 +1108,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ave middle cloud fraction - if(trim(fieldname) == 'tcdc_avemcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) + if(trim(fieldname)=='tcdc_avemcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgcfracm,arrayr42d) do j=jsta,jend do i=ista, iend avgcfracm(i,j) = arrayr42d(i,j) @@ -1116,8 +1121,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst convective cloud fraction - if(trim(fieldname) == 'tcdccnvcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) + if(trim(fieldname)=='tcdccnvcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cnvcfr,arrayr42d) do j=jsta,jend do i=ista, iend cnvcfr(i,j) = arrayr42d(i,j) @@ -1129,8 +1134,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! slope type - if(trim(fieldname) == 'sltyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) + if(trim(fieldname)=='sltyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,islope) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1143,8 +1148,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged column cloud fraction - if(trim(fieldname) == 'cnwat') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) + if(trim(fieldname)=='cnwat') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,cmc,arrayr42d,sm) do j=jsta,jend do i=ista, iend cmc(i,j) = arrayr42d(i,j) @@ -1155,8 +1160,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! frozen precip fraction - if(trim(fieldname) == 'cpofp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) + if(trim(fieldname)=='cpofp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,sr) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) /= spval) then @@ -1170,8 +1175,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sea ice skin temperature - if(trim(fieldname) == 'tisfc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) + if(trim(fieldname)=='tisfc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sice,arrayr42d,ti) do j=jsta,jend do i=ista,iend if (arrayr42d(i,j) /= spval) then @@ -1185,8 +1190,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation fraction - if(trim(fieldname) == 'veg') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) + if(trim(fieldname)=='veg') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,vegfrc,arrayr42d,sm) do j=jsta,jend do i=ista, iend vegfrc(i,j) = arrayr42d(i,j) @@ -1201,8 +1206,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,1) = arrayr42d(i,j) @@ -1212,8 +1217,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,2) = arrayr42d(i,j) @@ -1223,8 +1228,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,3) = arrayr42d(i,j) @@ -1234,8 +1239,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! liquid volumetric soil mpisture in fraction - if(trim(fieldname) == 'soill4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) + if(trim(fieldname)=='soill4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sh2o,arrayr42d,sm) do j=jsta,jend do i=ista, iend sh2o(i,j,4) = arrayr42d(i,j) @@ -1245,8 +1250,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,1) = arrayr42d(i,j) @@ -1256,8 +1261,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,2) = arrayr42d(i,j) @@ -1267,8 +1272,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,3) = arrayr42d(i,j) @@ -1278,8 +1283,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! volumetric soil moisture - if(trim(fieldname) == 'soilw4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) + if(trim(fieldname)=='soilw4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smc,arrayr42d,sm) do j=jsta,jend do i=ista, iend smc(i,j,4) = arrayr42d(i,j) @@ -1289,8 +1294,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt1') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt1') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,1) = arrayr42d(i,j) @@ -1301,8 +1306,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt2') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt2') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,2) = arrayr42d(i,j) @@ -1313,8 +1318,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt3') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt3') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,3) = arrayr42d(i,j) @@ -1325,8 +1330,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil temperature - if(trim(fieldname) == 'soilt4') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) + if(trim(fieldname)=='soilt4') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,stc,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend stc(i,j,4) = arrayr42d(i,j) @@ -1338,7 +1343,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged incoming sfc longwave if(trim(fieldname)=='dlwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwin,arrayr42d) do j=jsta,jend do i=ista, iend alwin(i,j) = arrayr42d(i,j) @@ -1347,8 +1352,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc longwave - if(trim(fieldname) == 'dlwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) + if(trim(fieldname)=='dlwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwin,arrayr42d) do j=jsta,jend do i=ista, iend rlwin(i,j) = arrayr42d(i,j) @@ -1357,8 +1362,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc longwave, CLDRAD puts a minus sign - if(trim(fieldname) == 'ulwrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) + if(trim(fieldname)=='ulwrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,alwout,arrayr42d) do j=jsta,jend do i=ista, iend alwout(i,j) = arrayr42d(i,j) @@ -1368,8 +1373,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc longwave - if(trim(fieldname) == 'ulwrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) + if(trim(fieldname)=='ulwrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,radot,arrayr42d) do j=jsta,jend do i=ista, iend radot(i,j) = arrayr42d(i,j) @@ -1378,8 +1383,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing model top longwave - if(trim(fieldname) == 'ulwrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) + if(trim(fieldname)=='ulwrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoa,arrayr42d) do j=jsta,jend do i=ista, iend alwtoa(i,j) = arrayr42d(i,j) @@ -1388,8 +1393,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc shortwave - if(trim(fieldname) == 'dswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) + if(trim(fieldname)=='dswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d) do j=jsta,jend do i=ista, iend aswin(i,j) = arrayr42d(i,j) @@ -1398,8 +1403,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst incoming sfc shortwave - if(trim(fieldname) == 'dswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) + if(trim(fieldname)=='dswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswin,arrayr42d) do j=jsta,jend do i=ista, iend rswin(i,j) = arrayr42d(i,j) @@ -1408,8 +1413,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc uv-b - if(trim(fieldname) == 'duvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) + if(trim(fieldname)=='duvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d) do j=jsta,jend do i=ista, iend auvbin(i,j) = arrayr42d(i,j) @@ -1418,8 +1423,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged incoming sfc clear sky uv-b - if(trim(fieldname) == 'cduvb_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) + if(trim(fieldname)=='cduvb_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbinc,arrayr42d) do j=jsta,jend do i=ista, iend auvbinc(i,j) = arrayr42d(i,j) @@ -1428,8 +1433,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged outgoing sfc shortwave,CLDRAD puts a minus sign - if(trim(fieldname) == 'uswrf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) + if(trim(fieldname)=='uswrf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,aswout,arrayr42d) do j=jsta,jend do i=ista, iend aswout(i,j) = arrayr42d(i,j) @@ -1439,8 +1444,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst outgoing sfc shortwave - if(trim(fieldname) == 'uswrf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) + if(trim(fieldname)=='uswrf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswout,arrayr42d) do j=jsta,jend do i=ista, iend rswout(i,j) = arrayr42d(i,j) @@ -1449,8 +1454,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged model top incoming shortwave - if(trim(fieldname) == 'dswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) + if(trim(fieldname)=='dswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswintoa,arrayr42d) do j=jsta,jend do i=ista, iend aswintoa(i,j) = arrayr42d(i,j) @@ -1459,8 +1464,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ime averaged model top outgoing shortwave - if(trim(fieldname) == 'uswrf_avetoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) + if(trim(fieldname)=='uswrf_avetoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoa,arrayr42d) do j=jsta,jend do i=ista, iend aswtoa(i,j) = arrayr42d(i,j) @@ -1470,8 +1475,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface sensible heat flux, multiplied by -1 because ! wrf model fluxhas reversed sign convention using gfsio - if(trim(fieldname) == 'shtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) + if(trim(fieldname)=='shtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfcshx,arrayr42d) do j=jsta,jend do i=ista, iend sfcshx(i,j) = arrayr42d(i,j) @@ -1481,8 +1486,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface sensible heat flux - if(trim(fieldname) == 'shtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) + if(trim(fieldname)=='shtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,twbs,arrayr42d) do j=jsta,jend do i=ista, iend twbs(i,j) = arrayr42d(i,j) @@ -1493,8 +1498,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged surface latent heat flux, multiplied by -1 because ! wrf model flux has reversed sign vonvention using gfsio - if(trim(fieldname) == 'lhtfl_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) + if(trim(fieldname)=='lhtfl_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,sfclhx,arrayr42d) do j=jsta,jend do i=ista, iend sfclhx(i,j) = arrayr42d(i,j) @@ -1504,8 +1509,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst surface latent heat flux - if(trim(fieldname) == 'lhtfl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) + if(trim(fieldname)=='lhtfl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,qwbs,arrayr42d) do j=jsta,jend do i=ista, iend qwbs(i,j) = arrayr42d(i,j) @@ -1515,30 +1520,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged ground heat flux - if(trim(fieldname) == 'gflux_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,subshx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend subshx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) subshx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval enddo enddo endif ! inst ground heat flux - if(trim(fieldname) == 'gflux') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) + if(trim(fieldname)=='gflux') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,grnflx,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend grnflx(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) grnflx(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval enddo enddo endif ! time averaged zonal momentum flux - if(trim(fieldname) == 'uflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) + if(trim(fieldname)=='uflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcux,arrayr42d) do j=jsta,jend do i=ista, iend sfcux(i,j) = arrayr42d(i,j) @@ -1547,8 +1552,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional momentum flux - if(trim(fieldname) == 'vflx_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) + if(trim(fieldname)=='vflx_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,sfcvx,arrayr42d) do j=jsta,jend do i=ista, iend sfcvx(i,j) = arrayr42d(i,j) @@ -1557,8 +1562,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged zonal gravity wave stress - if(trim(fieldname) == 'u-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) + if(trim(fieldname)=='u-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtaux,arrayr42d) do j=jsta,jend do i=ista, iend gtaux(i,j) = arrayr42d(i,j) @@ -1567,8 +1572,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged meridional gravity wave stress - if(trim(fieldname) == 'v-gwd_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) + if(trim(fieldname)=='v-gwd_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,gtauy,arrayr42d) do j=jsta,jend do i=ista, iend gtauy(i,j) = arrayr42d(i,j) @@ -1577,30 +1582,30 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged accumulated potential evaporation - if(trim(fieldname) == 'pevpr_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgpotevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgpotevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgpotevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval enddo enddo endif ! inst potential evaporation - if(trim(fieldname) == 'pevpr') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) + if(trim(fieldname)=='pevpr') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,potevp,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend potevp(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) potevp(i,j) = spval + if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval enddo enddo endif ! 10 m u - if(trim(fieldname) == 'ugrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) + if(trim(fieldname)=='ugrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,u10,arrayr42d,u10h) do j=jsta,jend do i=ista, iend u10(i,j) = arrayr42d(i,j) @@ -1610,8 +1615,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! 10 m v - if(trim(fieldname) == 'vgrd10m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) + if(trim(fieldname)=='vgrd10m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,v10,arrayr42d,v10h) do j=jsta,jend do i=ista, iend v10(i,j) = arrayr42d(i,j) @@ -1621,8 +1626,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! vegetation type - if(trim(fieldname) == 'vtype') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) + if(trim(fieldname)=='vtype') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,ivgtyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1635,8 +1640,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! soil type - if(trim(fieldname) == 'sotyp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) + if(trim(fieldname)=='sotyp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,arrayr42d,isltyp) do j=jsta,jend do i=ista, iend if (arrayr42d(i,j) < spval) then @@ -1649,8 +1654,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud top pressure - if(trim(fieldname) == 'prescnvclt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) + if(trim(fieldname)=='prescnvclt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ptop,arrayr42d) do j=jsta,jend do i=ista, iend ptop(i,j) = arrayr42d(i,j) @@ -1660,8 +1665,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! inst cloud bottom pressure - if(trim(fieldname) == 'prescnvclb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) + if(trim(fieldname)=='prescnvclb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pbot,arrayr42d) do j=jsta,jend do i=ista, iend pbot(i,j) = arrayr42d(i,j) @@ -1671,8 +1676,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top pressure - if(trim(fieldname) == 'pres_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) + if(trim(fieldname)=='pres_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopl,arrayr42d) do j=jsta,jend do i=ista, iend ptopl(i,j) = arrayr42d(i,j) @@ -1681,8 +1686,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud bottom pressure - if(trim(fieldname) == 'pres_avelcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) + if(trim(fieldname)=='pres_avelcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotl,arrayr42d) do j=jsta,jend do i=ista, iend pbotl(i,j) = arrayr42d(i,j) @@ -1691,8 +1696,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged low cloud top temperature - if(trim(fieldname) == 'tmp_avelct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) + if(trim(fieldname)=='tmp_avelct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopl,arrayr42d) do j=jsta,jend do i=ista, iend ttopl(i,j) = arrayr42d(i,j) @@ -1701,8 +1706,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top pressure - if(trim(fieldname) == 'pres_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) + if(trim(fieldname)=='pres_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptopm,arrayr42d) do j=jsta,jend do i=ista, iend ptopm(i,j) = arrayr42d(i,j) @@ -1711,8 +1716,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud bottom pressure - if(trim(fieldname) == 'pres_avemcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) + if(trim(fieldname)=='pres_avemcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pbotm,arrayr42d) do j=jsta,jend do i=ista, iend pbotm(i,j) = arrayr42d(i,j) @@ -1721,8 +1726,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged middle cloud top temperature - if(trim(fieldname) == 'tmp_avemct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) + if(trim(fieldname)=='tmp_avemct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttopm,arrayr42d) do j=jsta,jend do i=ista, iend ttopm(i,j) = arrayr42d(i,j) @@ -1731,8 +1736,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top pressure - if(trim(fieldname) == 'pres_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) + if(trim(fieldname)=='pres_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ptoph,arrayr42d) do j=jsta,jend do i=ista, iend ptoph(i,j) = arrayr42d(i,j) @@ -1741,8 +1746,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud bottom pressure - if(trim(fieldname) == 'pres_avehcb') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) + if(trim(fieldname)=='pres_avehcb') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,pboth,arrayr42d) do j=jsta,jend do i=ista, iend pboth(i,j) = arrayr42d(i,j) @@ -1751,8 +1756,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged high cloud top temperature - if(trim(fieldname) == 'tmp_avehct') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) + if(trim(fieldname)=='tmp_avehct') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ttoph,arrayr42d) do j=jsta,jend do i=ista, iend ttoph(i,j) = arrayr42d(i,j) @@ -1761,8 +1766,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged boundary layer cloud cover - if(trim(fieldname) == 'tcdc_avebndcl') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) + if(trim(fieldname)=='tcdc_avebndcl') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,pblcfr,arrayr42d) do j=jsta,jend do i=ista, iend pblcfr(i,j) = arrayr42d(i,j) @@ -1772,8 +1777,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! cloud work function - if(trim(fieldname) == 'cwork_aveclm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) + if(trim(fieldname)=='cwork_aveclm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,cldwork,arrayr42d) do j=jsta,jend do i=ista, iend cldwork(i,j) = arrayr42d(i,j) @@ -1782,8 +1787,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! water runoff - if(trim(fieldname) == 'watr_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) + if(trim(fieldname)=='watr_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,runoff,arrayr42d,sm) do j=jsta,jend do i=ista, iend runoff(i,j) = arrayr42d(i,j) @@ -1793,8 +1798,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max temperature - if(trim(fieldname) == 'tmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) + if(trim(fieldname)=='tmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxtshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxtshltr(i,j) = arrayr42d(i,j) @@ -1803,8 +1808,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'tmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) + if(trim(fieldname)=='tmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,mintshltr,arrayr42d) do j=jsta,jend do i=ista, iend mintshltr(i,j) = arrayr42d(i,j) @@ -1813,8 +1818,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! ice thickness - if(trim(fieldname) == 'icetk') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) + if(trim(fieldname)=='icetk') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dzice,arrayr42d) do j=jsta,jend do i=ista, iend dzice(i,j) = arrayr42d(i,j) @@ -1823,8 +1828,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! wilting point - if(trim(fieldname) == 'wilt') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) + if(trim(fieldname)=='wilt') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend, spval,smcwlt,arrayr42d,sm) do j=jsta,jend do i=ista, iend smcwlt(i,j) = arrayr42d(i,j) @@ -1834,8 +1839,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! sunshine duration - if(trim(fieldname) == 'sunsd_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) + if(trim(fieldname)=='sunsd_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,suntime,arrayr42d) do j=jsta,jend do i=ista, iend suntime(i,j) = arrayr42d(i,j) @@ -1844,8 +1849,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! field capacity - if(trim(fieldname) == 'fldcp') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) + if(trim(fieldname)=='fldcp') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,fieldcapa,arrayr42d,sm) do j=jsta,jend do i=ista, iend fieldcapa(i,j) = arrayr42d(i,j) @@ -1855,8 +1860,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible beam downward solar flux - if(trim(fieldname) == 'vbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) + if(trim(fieldname)=='vbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend avisbeamswin(i,j) = arrayr42d(i,j) @@ -1865,8 +1870,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface visible diffuse downward solar flux - if(trim(fieldname) == 'vddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) + if(trim(fieldname)=='vddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,avisdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend avisdiffswin(i,j) = arrayr42d(i,j) @@ -1875,8 +1880,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR beam downward solar flux - if(trim(fieldname) == 'nbdsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) + if(trim(fieldname)=='nbdsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airbeamswin,arrayr42d) do j=jsta,jend do i=ista, iend airbeamswin(i,j) = arrayr42d(i,j) @@ -1885,8 +1890,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface near IR diffuse downward solar flux - if(trim(fieldname) == 'nddsf_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) + if(trim(fieldname)=='nddsf_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,airdiffswin,arrayr42d) do j=jsta,jend do i=ista, iend airdiffswin(i,j) = arrayr42d(i,j) @@ -1895,8 +1900,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing LW - if(trim(fieldname) == 'csulf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) + if(trim(fieldname)=='csulf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwoutc,arrayr42d) do j=jsta,jend do i=ista, iend alwoutc(i,j) = arrayr42d(i,j) @@ -1905,8 +1910,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing LW - if(trim(fieldname) == 'csulftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) + if(trim(fieldname)=='csulftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwtoac,arrayr42d) do j=jsta,jend do i=ista, iend alwtoac(i,j) = arrayr42d(i,j) @@ -1915,8 +1920,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky outgoing SW - if(trim(fieldname) == 'csusf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) + if(trim(fieldname)=='csusf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswoutc,arrayr42d) do j=jsta,jend do i=ista, iend aswoutc(i,j) = arrayr42d(i,j) @@ -1925,8 +1930,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged TOA clear sky outgoing SW - if(trim(fieldname) == 'csusftoa') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) + if(trim(fieldname)=='csusftoa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswtoac,arrayr42d) do j=jsta,jend do i=ista, iend aswtoac(i,j) = arrayr42d(i,j) @@ -1935,8 +1940,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming LW - if(trim(fieldname) == 'csdlf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) + if(trim(fieldname)=='csdlf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,alwinc,arrayr42d) do j=jsta,jend do i=ista, iend alwinc(i,j) = arrayr42d(i,j) @@ -1945,8 +1950,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! time averaged surface clear sky incoming SW - if(trim(fieldname) == 'csdsf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) + if(trim(fieldname)=='csdsf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswinc,arrayr42d) do j=jsta,jend do i=ista, iend aswinc(i,j) = arrayr42d(i,j) @@ -1955,8 +1960,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter max specific humidity - if(trim(fieldname) == 'spfhmax_max2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) + if(trim(fieldname)=='spfhmax_max2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,maxqshltr,arrayr42d) do j=jsta,jend do i=ista, iend maxqshltr(i,j) = arrayr42d(i,j) @@ -1965,8 +1970,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! shelter min temperature - if(trim(fieldname) == 'spfhmin_min2m') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) + if(trim(fieldname)=='spfhmin_min2m') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,minqshltr,arrayr42d) do j=jsta,jend do i=ista, iend minqshltr(i,j) = arrayr42d(i,j) @@ -1975,8 +1980,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! storm runoffs - if(trim(fieldname) == 'ssrun_acc') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) + if(trim(fieldname)=='ssrun_acc') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,ssroff,arrayr42d,sm) do j=jsta,jend do i=ista, iend ssroff(i,j) = arrayr42d(i,j) @@ -1986,8 +1991,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! direct soil evaporation - if(trim(fieldname) == 'evbs_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) + if(trim(fieldname)=='evbs_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgedir,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgedir(i,j) = arrayr42d(i,j) @@ -1997,8 +2002,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! canopy water evap - if(trim(fieldname) == 'evcw_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) + if(trim(fieldname)=='evcw_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgecan,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgecan(i,j) = arrayr42d(i,j) @@ -2008,8 +2013,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! plant transpiration - if(trim(fieldname) == 'trans_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) + if(trim(fieldname)=='trans_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgetrans,arrayr42d,sm) do j=jsta,jend do i=ista, iend avgetrans(i,j) = arrayr42d(i,j) @@ -2019,19 +2024,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow sublimation - if(trim(fieldname) == 'sbsno_ave') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) + if(trim(fieldname)=='sbsno_ave') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,avgesnow,arrayr42d,sm,sice) do j=jsta,jend do i=ista, iend avgesnow(i,j) = arrayr42d(i,j) - if (sm(i,j) == 1.0 .and. sice(i,j) == 0.) avgesnow(i,j) = spval + if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval enddo enddo endif ! total soil moisture - if(trim(fieldname) == 'soilm') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) + if(trim(fieldname)=='soilm') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,smstot,arrayr42d,sm) do j=jsta,jend do i=ista, iend smstot(i,j) = arrayr42d(i,j) @@ -2041,8 +2046,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! snow phase change heat flux - if(trim(fieldname) == 'snohf') then -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) + if(trim(fieldname)=='snohf') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snopcx,arrayr42d,sm) do j=jsta,jend do i=ista, iend snopcx(i,j) = arrayr42d(i,j) @@ -2052,17 +2057,19 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! else if (fieldDimCount > gridDimCount) then - else if (fieldDimCount == 3) then + else if (fieldDimCount ==3) then if (typekind == ESMF_TYPEKIND_R4) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr43d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out else if (typekind == ESMF_TYPEKIND_R8) then call ESMF_FieldGet(fcstField(n), localDe=0, farrayPtr=arrayr83d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out allocate(arrayr43d(ista:iend,jsta:jend,kstart:kend)) arrayr43d = 0. do k=kstart,kend -!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,k,arrayr43d,arrayr83d) do j=jsta,jend do i=ista,iend arrayr43d(i,j,k) = arrayr83d(i,j,k) @@ -2072,8 +2079,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level T - if(trim(fieldname) == 'tmp') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) + if(trim(fieldname)=='tmp') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,t,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend @@ -2083,7 +2090,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo !! sig4 -!$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) + !$omp parallel do default(none) private(i,j,tlmh) shared(lm,jsta,jend,ista,iend,t,sigt4) do j=jsta,jend do i=ista, iend tlmh = t(i,j,lm) * t(i,j,lm) @@ -2093,218 +2100,152 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level spfh - if(trim(fieldname) == 'spfh') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) + if(trim(fieldname)=='spfh') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q(i,j,l) = arrayr43d(i,j,l) + q(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level u wind - if(trim(fieldname) == 'ugrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) + if(trim(fieldname)=='ugrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,uh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - uh(i,j,l) = arrayr43d(i,j,l) + uh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level v wind - if(trim(fieldname) == 'vgrd') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) + if(trim(fieldname)=='vgrd') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,vh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - vh(i,j,l) = arrayr43d(i,j,l) + vh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level pressure thinkness - if(trim(fieldname) == 'dpres') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) + if(trim(fieldname)=='dpres') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,dpres,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - dpres(i,j,l) = arrayr43d(i,j,l) + dpres(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level gh thinkness, model output negative delz - if(trim(fieldname) == 'delz') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) + if(trim(fieldname)=='delz') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,zint,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - zint(i,j,l) = -arrayr43d(i,j,l) + zint(i,j,l)=-1.*arrayr43d(i,j,l) enddo enddo enddo endif ! model level w - if(trim(fieldname) == 'dzdt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) + if(trim(fieldname)=='dzdt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,wh,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - wh(i,j,l) = arrayr43d(i,j,l) + wh(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ozone mixing ratio - if(trim(fieldname) == 'o3mr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) + if(trim(fieldname)=='o3mr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,o3,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - o3(i,j,l) = arrayr43d(i,j,l) + o3(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif -! for GFDL or MG3 MP or Thompson MP -! --------------------------------- - if (imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then +! for GFDL MP or Thompson MP + if (imp_physics == 11 .or. imp_physics == 8) then ! model level cloud water mixing ratio - if(trim(fieldname) == 'clwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) + if(trim(fieldname)=='clwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqw,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqw(i,j,l) = arrayr43d(i,j,l) + qqw(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ice mixing ratio - if(trim(fieldname) == 'icmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) + if(trim(fieldname)=='icmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqi,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqi(i,j,l) = arrayr43d(i,j,l) + qqi(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'rwmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) + if(trim(fieldname)=='rwmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqr(i,j,l) = arrayr43d(i,j,l) + qqr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level snow mixing ratio - if(trim(fieldname) == 'snmr') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) + if(trim(fieldname)=='snmr') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqs,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqs(i,j,l) = arrayr43d(i,j,l) + qqs(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level rain water mixing ratio - if(trim(fieldname) == 'grle') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqg(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - endif !gfdlmp or MG3 mp or Thompson mp -! for MG3 MP -! ---------- - if (imp_physics == 10) then - ! model level cloud water mixing ratio number concentration - if(trim(fieldname) == 'clwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d) + if(trim(fieldname)=='grle') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqg,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - qqnw(i,j,l) = arrayr43d(i,j,l) + qqg(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif - ! model level ice mixing ratio number concentration - if(trim(fieldname) == 'icenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqni(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'rwnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqnr(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level snow mixing ratio number concentration - if(trim(fieldname) == 'snnc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqns,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqns(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - - ! model level rain water mixing ratio number concentration - if(trim(fieldname) == 'grlenc') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqng,arrayr43d) - do l=1,lm - do j=jsta,jend - do i=ista, iend - qqng(i,j,l) = arrayr43d(i,j,l) - enddo - enddo - enddo - endif - endif ! for MG3 MP - - if(imp_physics == 8) then + if(imp_physics == 8) then ! model level rain number if(trim(fieldname)=='ncrain') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d) @@ -2352,28 +2293,29 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif - endif !if(imp_physics == 8) then + endif !if(imp_physics == 8) then !gfdlmp + endif ! model level cloud amount - if(trim(fieldname) == 'cld_amt') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) + if(trim(fieldname)=='cld_amt') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,cfr,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - cfr(i,j,l) = arrayr43d(i,j,l) + cfr(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo endif ! model level ref3d - if(trim(fieldname) == 'ref3D') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) + if(trim(fieldname)=='ref3D') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,ref_10cm,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - ref_10cm(i,j,l) = arrayr43d(i,j,l) + ref_10cm(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2381,12 +2323,12 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & endif ! model level ref3d - if(trim(fieldname) == 'tke') then -!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) + if(trim(fieldname)=='tke') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,q2,arrayr43d) do l=1,lm do j=jsta,jend do i=ista, iend - q2(i,j,l) = arrayr43d(i,j,l) + q2(i,j,l)=arrayr43d(i,j,l) enddo enddo enddo @@ -2394,7 +2336,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !3d fields endif - enddo ! end loop ncount_field +! end loop ncount_field + enddo if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) & setvar_atmfile = .true. @@ -2420,33 +2363,46 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,omga,wh,dpres,zint) do j=jsta,jend do i=1,im - omga(i,j,l) = - wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) + omga(i,j,l) = (-1.) * wh(i,j,l) * dpres(i,j,l)/zint(i,j,l) zint(i,j,l) = zint(i,j,l) + zint(i,j,l+1) enddo enddo enddo ! compute pint from top down -!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint,pd,spval) +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,ak5,pint) do j=jsta,jend do i=1,im pint(i,j,1) = ak5(1) - pd(i,j) = spval - enddo - enddo + end do + end do do l=2,lp1 - ll = l - 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,pint,dpres,pmid) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pint,dpres) do j=jsta,jend do i=1,im - pint(i,j,l) = pint(i,j,ll) + dpres(i,j,ll) + pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) + enddo + enddo + end do + !compute pmid from averaged two layer pint - pmid(i,j,ll) = 0.5*(pint(i,j,ll)+pint(i,j,l)) + do l=lm,1,-1 +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,pmid,pint) + do j=jsta,jend + do i=1,im + pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) enddo enddo enddo +!$omp parallel do default(none) private(i,j) shared(jsta,jend,im,spval,pt,pd,pint) + do j=jsta,jend + do i=1,im + pd(i,j) = spval + pint(i,j,1) = pt + end do + end do ! print *,'in setvar, pt=',pt,'ak5(lp1)=', ak5(lp1),'ak5(1)=',ak5(1) ! compute alpint @@ -2454,23 +2410,22 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,alpint,pint) do j=jsta,jend do i=1,im - alpint(i,j,l) = log(pint(i,j,l)) - enddo - enddo - enddo + alpint(i,j,l)=log(pint(i,j,l)) + end do + end do + end do ! compute zmid do l=lm,1,-1 - ll = l + 1 -!$omp parallel do default(none) private(i,j) shared(l,ll,jsta,jend,im,zmid,zint,pmid,alpint) +!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint) do j=jsta,jend do i=1,im - zmid(i,j,l) = zint(i,j,ll) + (zint(i,j,l)-zint(i,j,ll)) & - * (log(pmid(i,j,l))-alpint(i,j,ll)) & - / (alpint(i,j,l)-alpint(i,j,ll)) - enddo - enddo - enddo + zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* & + (log(pmid(i,j,l))-alpint(i,j,l+1))/ & + (alpint(i,j,l)-alpint(i,j,l+1)) + end do + end do + end do ! print *,'in post_gfs,zmid=',maxval(zmid(1:im,jsta:jend,1)), & ! minval(zmid(1:im,jsta:jend,1)),maxloc(zmid(1:im,jsta:jend,1)), & ! 'zint=',maxval(zint(1:im,jsta:jend,2)),minval(zint(1:im,jsta:jend,1)), & @@ -2496,13 +2451,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo -! compute cwm for gfdlmp or MG3 or Thompson - if( imp_physics == 10 .or. imp_physics == 11 .or. imp_physics == 8) then +! compute cwm for gfdlmp or Thompson + if( imp_physics == 11 .or. imp_physics == 8) then do l=1,lm !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qqg,qqs,qqr,qqi,qqw) do j=jsta,jend do i=ista,iend - cwm(i,j,l) = qqg(i,j,l) + qqs(i,j,l) + qqr(i,j,l) + qqi(i,j,l) + qqw(i,j,l) + cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l) enddo enddo enddo @@ -2512,8 +2467,8 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,lm,pshltr,pint,tshltr) do j=jsta,jend do i=ista, iend - pshltr(I,J) = pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j) = tshltr(i,j)*(p1000/pshltr(I,J))**CAPA + pshltr(I,J)=pint(i,j,lm+1)*EXP(-0.068283/tshltr(i,j)) + tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(I,J))**CAPA enddo enddo @@ -2524,13 +2479,13 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(ptop(i,j) < spval)then do l=1,lm if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l + htop(i,j)=l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! hbot do j=jsta,jend @@ -2541,11 +2496,11 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & if(pbot(i,j) >= pmid(i,j,l)) then hbot(i,j) = l exit - endif - enddo - endif - enddo - enddo + end if + end do + end if + end do + end do ! generate look up table for lifted parcel calculations thl = 210. @@ -2567,7 +2522,7 @@ subroutine set_postvars_gfs(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(none) private(l) shared(lsm,alsl,spl) do l = 1,lsm alsl(l) = log(spl(l)) - enddo + end do ! ! print *,'in gfs_post, end ref_10cm=',maxval(ref_10cm), minval(ref_10cm) !!! above is fv3 change From d6d014f8880c48131bdda60f0a9e5c4dba471d1a Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 21 Sep 2021 16:58:53 +0000 Subject: [PATCH 196/217] fix typo in .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index a9f576a6f..7910f6fc4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAH-GFDL/GFDL_atmos_cubed_sphere + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework From 21593892afb6cc1e0d4ad767aa907986ca9a70e6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 21 Sep 2021 18:55:16 +0000 Subject: [PATCH 197/217] reverting a change in atmos_model.F90 --- atmos_model.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 382e51367..abf0d68bb 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -261,10 +261,6 @@ subroutine update_atmos_radiation_physics (Atmos) call CCPP_step (step="timestep_init", nblks=Atm_block%nblks, ierr=ierr) if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP timestep_init step failed') -!--- if coupled, assign coupled fields - call assign_importdata(jdat(:),rc) - if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') - if (GFS_Control%do_sppt .or. GFS_Control%do_shum .or. GFS_Control%do_skeb .or. & GFS_Control%lndp_type > 0 .or. GFS_Control%do_ca ) then !--- call stochastic physics pattern generation / cellular automata @@ -272,6 +268,10 @@ subroutine update_atmos_radiation_physics (Atmos) if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed') endif +!--- if coupled, assign coupled fields + call assign_importdata(jdat(:),rc) + if (rc/=0) call mpp_error(FATAL, 'Call to assign_importdata failed') + ! Calculate total non-physics tendencies by substracting old GFS Stateout ! variables from new/updated GFS Statein variables (gives the tendencies ! due to anything else than physics) From fab227051a92a51332ae69735f94480c2846f5b6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 22 Sep 2021 11:38:38 +0000 Subject: [PATCH 198/217] after syncing submodules --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 12d85af52..2dd3ce46a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 12d85af52c95ed36e52d91a5f9549e80a4a8d8cb +Subproject commit 2dd3ce46a10c4852d854a1b529147c8402aec854 From 32218076f55402890d09b548d10a0a87201a4e80 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 25 Sep 2021 01:16:26 +0000 Subject: [PATCH 199/217] updating GFS_typedefs.F90 to to define sncove_ice outside of RUC if --- ccpp/data/GFS_typedefs.F90 | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index b10912f52..6b9398a62 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2465,6 +2465,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%hice (IM)) allocate (Sfcprop%weasd (IM)) allocate (Sfcprop%sncovr (IM)) + allocate (Sfcprop%sncovr_ice (IM)) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%albdirvis_ice (IM)) allocate (Sfcprop%albdifvis_ice (IM)) @@ -2473,7 +2474,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) ! allocate (Sfcprop%sfalb_ice (IM)) endif if (Model%lsm == Model%lsm_ruc) then - allocate (Sfcprop%sncovr_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2491,6 +2491,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%hice = clear_val Sfcprop%weasd = clear_val Sfcprop%sncovr = clear_val + Sfcprop%sncovr_ice = clear_val if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then Sfcprop%albdirvis_ice = clear_val Sfcprop%albdifvis_ice = clear_val @@ -2499,7 +2500,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) ! Sfcprop%sfalb_ice = clear_val endif if (Model%lsm == Model%lsm_ruc) then - Sfcprop%sncovr_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val diff --git a/ccpp/physics b/ccpp/physics index 6a2cb7d5b..1d3e76215 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 6a2cb7d5b124d3c610f6ba14cbc56150b255a279 +Subproject commit 1d3e762159044c0beebea987654f03aa78abc8e4 From 23257fe48c7cc802e2b23d2142cacb0fb67736f1 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 25 Sep 2021 01:26:49 +0000 Subject: [PATCH 200/217] updating GFS_typedefs.F90 to to define sncove_ice outside of RUC if --- ccpp/data/GFS_typedefs.F90 | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index b10912f52..6b9398a62 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2465,6 +2465,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%hice (IM)) allocate (Sfcprop%weasd (IM)) allocate (Sfcprop%sncovr (IM)) + allocate (Sfcprop%sncovr_ice (IM)) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then allocate (Sfcprop%albdirvis_ice (IM)) allocate (Sfcprop%albdifvis_ice (IM)) @@ -2473,7 +2474,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) ! allocate (Sfcprop%sfalb_ice (IM)) endif if (Model%lsm == Model%lsm_ruc) then - allocate (Sfcprop%sncovr_ice (IM)) allocate (Sfcprop%sfalb_lnd (IM)) allocate (Sfcprop%sfalb_ice (IM)) allocate (Sfcprop%sfalb_lnd_bck (IM)) @@ -2491,6 +2491,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%hice = clear_val Sfcprop%weasd = clear_val Sfcprop%sncovr = clear_val + Sfcprop%sncovr_ice = clear_val if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then Sfcprop%albdirvis_ice = clear_val Sfcprop%albdifvis_ice = clear_val @@ -2499,7 +2500,6 @@ subroutine sfcprop_create (Sfcprop, IM, Model) ! Sfcprop%sfalb_ice = clear_val endif if (Model%lsm == Model%lsm_ruc) then - Sfcprop%sncovr_ice = clear_val Sfcprop%sfalb_lnd = clear_val Sfcprop%sfalb_ice = clear_val Sfcprop%sfalb_lnd_bck = clear_val diff --git a/ccpp/physics b/ccpp/physics index 2dbfdbdfd..34aa8c885 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2dbfdbdfd2c8b76a1ff80edb6b6e421234dc5131 +Subproject commit 34aa8c885682f8b67a2c608275398bbaaf340783 From 98c56bcbfc570b80481b4532607a248c4f6768f1 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 27 Sep 2021 14:06:03 +0000 Subject: [PATCH 201/217] remove/add some blanks --- ccpp/physics | 2 +- io/post_gfs.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 1d3e76215..9e14237c5 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1d3e762159044c0beebea987654f03aa78abc8e4 +Subproject commit 9e14237c5cc973a4561149cbb57faae6d18cdf54 diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index edf06f4c2..614095148 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -252,7 +252,7 @@ subroutine post_getattr_gfs(wrt_int_state) ! ! field bundle do nfb=1, wrt_int_state%FBcount - fldbundle = wrt_int_state%wrtFB(nfb) + fldbundle = wrt_int_state%wrtFB(nfb) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & @@ -267,7 +267,7 @@ subroutine post_getattr_gfs(wrt_int_state) typekind=typekind, itemCount=n, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return - if (typekind==ESMF_TYPEKIND_I4 ) then + if (typekind == ESMF_TYPEKIND_I4) then if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), value=varival, rc=rc) From 438ab87e3c9d0918537b38f570e9ef82501a93e0 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 28 Sep 2021 16:06:43 +0000 Subject: [PATCH 202/217] updating to use estimated emissivity from the ice model when coupled --- atmos_model.F90 | 6 +++++- ccpp/data/GFS_typedefs.F90 | 8 ++++---- ccpp/data/GFS_typedefs.meta | 11 ++--------- ccpp/physics | 2 +- 4 files changed, 12 insertions(+), 15 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 382e51367..36d77bbf6 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1641,6 +1641,7 @@ subroutine assign_importdata(jdat, rc) ! real(kind=GFS_kind_phys), parameter :: hsmax = 100.0 !< maximum snow depth (m) allowed real(kind=GFS_kind_phys), parameter :: himax = 1.0e12 !< maximum ice thickness allowed real(kind=GFS_kind_phys), parameter :: hsmax = 1.0e12 !< maximum snow depth (m) allowed + real(kind=GFS_kind_phys), parameter :: con_sbc = 5.670400e-8_GFS_kind_phys !< stefan-boltzmann ! !------------------------------------------------------------------------------ ! @@ -2478,7 +2479,7 @@ subroutine assign_importdata(jdat, rc) ! update sea ice related fields: if( lcpl_fice ) then -!$omp parallel do default(shared) private(i,j,nb,ix) +!$omp parallel do default(shared) private(i,j,nb,ix,tem) do j=jsc,jec do i=isc,iec nb = Atm_block%blkno(i,j) @@ -2489,6 +2490,9 @@ subroutine assign_importdata(jdat, rc) GFS_data(nb)%Coupling%hsnoin_cpl(ix) = min(hsmax, GFS_data(nb)%Coupling%hsnoin_cpl(ix) & / (GFS_data(nb)%Sfcprop%fice(ix)*GFS_data(nb)%Sfcprop%oceanfrac(ix))) GFS_data(nb)%Sfcprop%zorli(ix) = z0ice + tem = GFS_data(nb)%Sfcprop%tisfc(ix) * GFS_data(nb)%Sfcprop%tisfc(ix) + GFS_data(nb)%Sfcprop%emis_ice(ix) = GFS_data(nb)%Coupling%ulwsfcin_cpl(ix) & + / (con_sbc * tem * tem) else GFS_data(nb)%Sfcprop%tisfc(ix) = GFS_data(nb)%Sfcprop%tsfco(ix) GFS_data(nb)%Sfcprop%fice(ix) = zero diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 6b9398a62..56fdcd521 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2075,7 +2075,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: trans(:) => null() !< real (kind=kind_phys), pointer :: tseal(:) => null() !< real (kind=kind_phys), pointer :: tsfa(:) => null() !< - real (kind=kind_phys), pointer :: tsfc_ice(:) => null() !< +! real (kind=kind_phys), pointer :: tsfc_ice(:) => null() !< real (kind=kind_phys), pointer :: tsfc_land_save(:) => null() !< real (kind=kind_phys), pointer :: tsfc_water(:) => null() !< real (kind=kind_phys), pointer :: tsfg(:) => null() !< @@ -7139,7 +7139,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%trans (IM)) allocate (Interstitial%tseal (IM)) allocate (Interstitial%tsfa (IM)) - allocate (Interstitial%tsfc_ice (IM)) +! allocate (Interstitial%tsfc_ice (IM)) allocate (Interstitial%tsfc_water (IM)) allocate (Interstitial%tsfg (IM)) allocate (Interstitial%tsurf_ice (IM)) @@ -7868,7 +7868,7 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%tprcp_water = huge Interstitial%trans = clear_val Interstitial%tseal = clear_val - Interstitial%tsfc_ice = huge +! Interstitial%tsfc_ice = huge Interstitial%tsfc_water = huge Interstitial%tsurf_ice = huge Interstitial%tsurf_land = huge @@ -8254,7 +8254,7 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%trans ) = ', sum(Interstitial%trans ) write (0,*) 'sum(Interstitial%tseal ) = ', sum(Interstitial%tseal ) write (0,*) 'sum(Interstitial%tsfa ) = ', sum(Interstitial%tsfa ) - write (0,*) 'sum(Interstitial%tsfc_ice ) = ', sum(Interstitial%tsfc_ice ) +! write (0,*) 'sum(Interstitial%tsfc_ice ) = ', sum(Interstitial%tsfc_ice ) write (0,*) 'sum(Interstitial%tsfc_water ) = ', sum(Interstitial%tsfc_water ) write (0,*) 'sum(Interstitial%tsfg ) = ', sum(Interstitial%tsfg ) write (0,*) 'sum(Interstitial%tsurf_ice ) = ', sum(Interstitial%tsurf_ice ) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 5a4d86cbd..e252c5868 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -516,8 +516,8 @@ type = real kind = kind_phys [tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice units = K dimensions = (horizontal_loop_extent) type = real @@ -9773,13 +9773,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[tsfc_ice] - standard_name = surface_skin_temperature_over_ice - long_name = surface skin temperature over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation diff --git a/ccpp/physics b/ccpp/physics index f452fc554..3618e6655 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit f452fc5543fa59ffa8a4c9ef07589d2e79377ed8 +Subproject commit 3618e665523f3fb41bb68347e806ac787907873c From 26c4cb122bf935fe28f0df5de0ddacb45d0aa930 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 29 Sep 2021 13:32:22 +0000 Subject: [PATCH 203/217] switching calling sfc_sice before nst in two suites --- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml | 6 +++--- ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 78eb236fb..4d33e7160 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 78eb236fb6019da607e29e70815320454e366132 +Subproject commit 4d33e7160858e4e00c9dc93c778ab39c44a7bb94 diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml index 668cd825d..8b1a37662 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstrasugwpnoahmp.xml @@ -45,12 +45,12 @@ sfc_diff GFS_surface_loop_control_part1 - sfc_nst_pre - sfc_nst - sfc_nst_post noahmpdrv sfc_cice sfc_sice + sfc_nst_pre + sfc_nst + sfc_nst_post GFS_surface_loop_control_part2 diff --git a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml index d0bc56c9e..10d0043aa 100644 --- a/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml +++ b/ccpp/suites/suite_FV3_GFSv17alp_cpldnsstsasugwpnoahmp.xml @@ -45,12 +45,12 @@ sfc_diff GFS_surface_loop_control_part1 - sfc_nst_pre - sfc_nst - sfc_nst_post noahmpdrv sfc_cice sfc_sice + sfc_nst_pre + sfc_nst + sfc_nst_post GFS_surface_loop_control_part2 From 0a2c6c09368b0e405fca3a74538d7570e7a8a363 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 30 Sep 2021 00:33:23 +0000 Subject: [PATCH 204/217] making 'huge' a namelist variable --- ccpp/data/GFS_typedefs.F90 | 144 ++++++++++++++++++------------------ ccpp/data/GFS_typedefs.meta | 14 ++-- ccpp/physics | 2 +- 3 files changed, 82 insertions(+), 78 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 56fdcd521..c0c518c10 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -58,7 +58,7 @@ module GFS_typedefs !--- parameter constants used for default initializations real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue +! real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue real(kind=kind_phys), parameter :: clear_val = zero !real(kind=kind_phys), parameter :: clear_val = -9.9999e80 real(kind=kind_phys), parameter :: rann_init = 0.6_kind_phys @@ -1293,6 +1293,7 @@ module GFS_typedefs real(kind=kind_phys) :: dxmax ! maximum scaling factor for critical relative humidity, replaces dxmax in physcons.F90 real(kind=kind_phys) :: dxmin ! minimum scaling factor for critical relative humidity, replaces dxmin in physcons.F90 real(kind=kind_phys) :: rhcmax ! maximum critical relative humidity, replaces rhc_max in physcons.F90 + real(kind=kind_phys) :: huge !< huge fill value contains procedure :: init => control_initialize @@ -3557,6 +3558,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! max and min lon and lat for critical relative humidity integer :: max_lon=5000, max_lat=2000, min_lon=192, min_lat=94 real(kind=kind_phys) :: rhcmax = 0.9999999 !< max critical rel. hum. + real(kind=kind_phys) :: huge = 9.9692099683868690E36 ! NetCDF float FillValue + !--- stochastic physics control parameters logical :: do_sppt = .false. @@ -3684,7 +3687,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- debug options debug, pre_rad, print_diff_pgr, & !--- parameter range for critical relative humidity - max_lon, max_lat, min_lon, min_lat, rhcmax, & + max_lon, max_lat, min_lon, min_lat, rhcmax, huge, & phys_version, & !--- aerosol scavenging factors ('name:value' string array) fscav_aero @@ -4795,9 +4798,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%dxmin = log(tem/(min_lon*min_lat)) Model%dxinv = 1.0d0 / (Model%dxmax-Model%dxmin) Model%rhcmax = rhcmax + Model%huge = huge if (Model%me == Model%master) write(*,*)' dxmax=',Model%dxmax,' dxmin=',Model%dxmin,' dxinv=',Model%dxinv, & 'max_lon=',max_lon,' max_lat=',max_lat,' min_lon=',min_lon,' min_lat=',min_lat, & - ' rhc_max=',Model%rhcmax + ' rhc_max=',Model%rhcmax,' huge=',huge !--- set nrcm if (Model%ras) then @@ -6715,7 +6719,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%sbsnoa = zero Diag%snowca = zero Diag%soilm = zero - Diag%tmpmin = huge + Diag%tmpmin = Model%huge Diag%tmpmax = zero Diag%dusfc = zero Diag%dvsfc = zero @@ -6731,7 +6735,7 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%dugwd = zero Diag%dvgwd = zero Diag%psmean = zero - Diag%spfhmin = huge + Diag%spfhmin = Model%huge Diag%spfhmax = zero Diag%u10mmax = zero Diag%v10mmax = zero @@ -7721,24 +7725,24 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%adjvisdfd = clear_val Interstitial%bexp1d = clear_val Interstitial%cd = clear_val - Interstitial%cd_ice = huge - Interstitial%cd_land = huge - Interstitial%cd_water = huge + Interstitial%cd_ice = Model%huge + Interstitial%cd_land = Model%huge + Interstitial%cd_water = Model%huge Interstitial%cdq = clear_val - Interstitial%cdq_ice = huge - Interstitial%cdq_land = huge - Interstitial%cdq_water = huge - Interstitial%chh_ice = huge - Interstitial%chh_land = huge - Interstitial%chh_water = huge + Interstitial%cdq_ice = Model%huge + Interstitial%cdq_land = Model%huge + Interstitial%cdq_water = Model%huge + Interstitial%chh_ice = Model%huge + Interstitial%chh_land = Model%huge + Interstitial%chh_water = Model%huge Interstitial%cld1d = clear_val Interstitial%cldf = clear_val Interstitial%clw = clear_val Interstitial%clw(:,:,2) = -999.9 Interstitial%clx = clear_val - Interstitial%cmm_ice = huge - Interstitial%cmm_land = huge - Interstitial%cmm_water = huge + Interstitial%cmm_ice = Model%huge + Interstitial%cmm_land = Model%huge + Interstitial%cmm_water = Model%huge Interstitial%cnvc = clear_val Interstitial%cnvw = clear_val Interstitial%ctei_r = clear_val @@ -7764,31 +7768,31 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%dvsfc1 = clear_val Interstitial%elvmax = clear_val Interstitial%ep1d = clear_val - Interstitial%ep1d_ice = huge - Interstitial%ep1d_land = huge - Interstitial%ep1d_water = huge - Interstitial%evap_ice = huge - Interstitial%evap_land = huge - Interstitial%evap_water = huge + Interstitial%ep1d_ice = Model%huge + Interstitial%ep1d_land = Model%huge + Interstitial%ep1d_water = Model%huge + Interstitial%evap_ice = Model%huge + Interstitial%evap_land = Model%huge + Interstitial%evap_water = Model%huge Interstitial%evbs = clear_val Interstitial%evcw = clear_val - Interstitial%ffhh_ice = huge - Interstitial%ffhh_land = huge - Interstitial%ffhh_water = huge + Interstitial%ffhh_ice = Model%huge + Interstitial%ffhh_land = Model%huge + Interstitial%ffhh_water = Model%huge Interstitial%fh2 = clear_val - Interstitial%fh2_ice = huge - Interstitial%fh2_land = huge - Interstitial%fh2_water = huge + Interstitial%fh2_ice = Model%huge + Interstitial%fh2_land = Model%huge + Interstitial%fh2_water = Model%huge Interstitial%flag_cice = .false. Interstitial%flag_guess = .false. Interstitial%flag_iter = .true. - Interstitial%ffmm_ice = huge - Interstitial%ffmm_land = huge - Interstitial%ffmm_water = huge + Interstitial%ffmm_ice = Model%huge + Interstitial%ffmm_land = Model%huge + Interstitial%ffmm_water = Model%huge Interstitial%fm10 = clear_val - Interstitial%fm10_ice = huge - Interstitial%fm10_land = huge - Interstitial%fm10_water = huge + Interstitial%fm10_ice = Model%huge + Interstitial%fm10_land = Model%huge + Interstitial%fm10_water = Model%huge Interstitial%frland = clear_val Interstitial%fscav = clear_val Interstitial%fswtr = clear_val @@ -7808,9 +7812,9 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%zvfun = clear_val Interstitial%hffac = clear_val Interstitial%hflxq = clear_val - Interstitial%hflx_ice = huge - Interstitial%hflx_land = huge - Interstitial%hflx_water = huge + Interstitial%hflx_ice = Model%huge + Interstitial%hflx_land = Model%huge + Interstitial%hflx_water = Model%huge Interstitial%dry = .false. Interstitial%icy = .false. Interstitial%lake = .false. @@ -7828,17 +7832,17 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%oc = clear_val Interstitial%prcpmp = clear_val Interstitial%prnum = clear_val - Interstitial%qss_ice = huge - Interstitial%qss_land = huge - Interstitial%qss_water = huge + Interstitial%qss_ice = Model%huge + Interstitial%qss_land = Model%huge + Interstitial%qss_water = Model%huge Interstitial%raincd = clear_val Interstitial%raincs = clear_val Interstitial%rainmcadj = clear_val Interstitial%rainp = clear_val Interstitial%rb = clear_val - Interstitial%rb_ice = huge - Interstitial%rb_land = huge - Interstitial%rb_water = huge + Interstitial%rb_ice = Model%huge + Interstitial%rb_land = Model%huge + Interstitial%rb_water = Model%huge Interstitial%rhc = clear_val Interstitial%runoff = clear_val Interstitial%save_q = clear_val @@ -7854,38 +7858,38 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%sigmatot = clear_val Interstitial%slopetype = 0 Interstitial%snowc = clear_val - Interstitial%snowd_ice = huge + Interstitial%snowd_ice = Model%huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val Interstitial%soiltype = 0 Interstitial%stress = clear_val - Interstitial%stress_ice = huge - Interstitial%stress_land = huge - Interstitial%stress_water = huge + Interstitial%stress_ice = Model%huge + Interstitial%stress_land = Model%huge + Interstitial%stress_water = Model%huge Interstitial%theta = clear_val - Interstitial%tprcp_ice = huge - Interstitial%tprcp_land = huge - Interstitial%tprcp_water = huge + Interstitial%tprcp_ice = Model%huge + Interstitial%tprcp_land = Model%huge + Interstitial%tprcp_water = Model%huge Interstitial%trans = clear_val Interstitial%tseal = clear_val -! Interstitial%tsfc_ice = huge - Interstitial%tsfc_water = huge - Interstitial%tsurf_ice = huge - Interstitial%tsurf_land = huge - Interstitial%tsurf_water = huge +! Interstitial%tsfc_ice = Model%huge + Interstitial%tsfc_water = Model%huge + Interstitial%tsurf_ice = Model%huge + Interstitial%tsurf_land = Model%huge + Interstitial%tsurf_water = Model%huge Interstitial%ud_mf = clear_val - Interstitial%uustar_ice = huge - Interstitial%uustar_land = huge - Interstitial%uustar_water = huge + Interstitial%uustar_ice = Model%huge + Interstitial%uustar_land = Model%huge + Interstitial%uustar_water = Model%huge Interstitial%vdftra = clear_val Interstitial%vegf1d = clear_val Interstitial%lndp_vgf = clear_val Interstitial%vegtype = 0 Interstitial%wcbmax = clear_val - Interstitial%weasd_ice = huge -! Interstitial%weasd_land = huge -! Interstitial%weasd_water = huge - Interstitial%wind = huge + Interstitial%weasd_ice = Model%huge +! Interstitial%weasd_land = Model%huge +! Interstitial%weasd_water = Model%huge + Interstitial%wind = Model%huge Interstitial%work1 = clear_val Interstitial%work2 = clear_val Interstitial%work3 = clear_val @@ -7973,20 +7977,20 @@ subroutine interstitial_phys_reset (Interstitial, Model) end if if (Model%lsm == Model%lsm_noah_wrfv4) then Interstitial%canopy_save = clear_val - Interstitial%chk_land = huge + Interstitial%chk_land = Model%huge Interstitial%cmc = clear_val Interstitial%dqsdt2 = clear_val Interstitial%drain_in_m_sm1 = clear_val Interstitial%flag_lsm = .false. Interstitial%flag_lsm_glacier= .false. - Interstitial%qs1 = huge - Interstitial%qv1 = huge + Interstitial%qs1 = Model%huge + Interstitial%qv1 = Model%huge Interstitial%rho1 = clear_val Interstitial%runoff_in_m_sm1 = clear_val Interstitial%slc_save = clear_val Interstitial%smcmax = clear_val Interstitial%smc_save = clear_val - Interstitial%snowd_land_save = huge + Interstitial%snowd_land_save = Model%huge Interstitial%snow_depth = clear_val Interstitial%snohf_snow = clear_val Interstitial%snohf_frzgra = clear_val @@ -7994,9 +7998,9 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%soilm_in_m = clear_val Interstitial%stc_save = clear_val Interstitial%th1 = clear_val - Interstitial%tprcp_rate_land = huge - Interstitial%tsfc_land_save = huge - Interstitial%weasd_land_save = huge + Interstitial%tprcp_rate_land = Model%huge + Interstitial%tsfc_land_save = Model%huge + Interstitial%weasd_land_save = Model%huge end if ! ! Set flag for resetting maximum hourly output fields diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index e252c5868..9a5eca0fb 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -5173,6 +5173,13 @@ dimensions = () type = real kind = kind_phys +[huge] + standard_name = netcdf_float_fillvalue + long_name = definition of NetCDF float FillValue + units = none + dimensions = () + type = real + kind = kind_phys [icloud] standard_name = control_for_cloud_area_fraction_option long_name = cloud effect to the optical depth and cloud fraction in radiation @@ -10668,13 +10675,6 @@ units = none dimensions = () type = integer -[huge] - standard_name = netcdf_float_fillvalue - long_name = definition of NetCDF float FillValue - units = none - dimensions = () - type = real - kind = kind_phys [con_cliq] standard_name = specific_heat_of_liquid_water_at_constant_pressure long_name = specific heat of liquid water at constant pressure diff --git a/ccpp/physics b/ccpp/physics index 84956ba0b..7445eb03c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 84956ba0b4ce0c56a02bd052e578a7a73a2b736c +Subproject commit 7445eb03cd4622264e1af43b81b0e264ba18b8a3 From db3687efa97c47ac452d09a2a7f4c9c598054817 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 1 Oct 2021 16:31:39 +0000 Subject: [PATCH 205/217] a temporary fix for underflow in FV3GFS_io for tiice --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index d6f8ad46b..0fd3702f8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d6f8ad46ba443193192c8fe42dbdbdd27ef0d304 +Subproject commit 0fd3702f82edf15d8310297cc405984d2a8c3e53 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 6c046d598..8f867c26a 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2152,6 +2152,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature + if (sfc_var3ice(i,j,k) < one) sfc_var3ice(i,j,k) = zero enddo if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then From 48ec11ce6f2ca543bd9d33479849c8cc7dcdb7bd Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 1 Oct 2021 18:31:51 +0000 Subject: [PATCH 206/217] after merge with fv3atm/develop --- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 1 + io/post_gfs.F90 | 8 ++++---- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 4cdbcb09f..738ce457e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4cdbcb09fcecbbaa98e3913eb61a221702d980f4 +Subproject commit 738ce457e81cbf975cf4817a54301c2378fc6872 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 6c046d598..8f867c26a 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2152,6 +2152,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature + if (sfc_var3ice(i,j,k) < one) sfc_var3ice(i,j,k) = zero enddo if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. Model%lsm == Model%lsm_noah_wrfv4) then diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 614095148..f33ba1532 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -256,10 +256,10 @@ subroutine post_getattr_gfs(wrt_int_state) ! look at the field bundle attributes call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) + attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return ! - aklen=0. + aklen = 0. do i=1, attCount call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & @@ -302,7 +302,7 @@ subroutine post_getattr_gfs(wrt_int_state) else if (typekind == ESMF_TYPEKIND_R8) then if(n == 1) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), value=varr8val, rc=rc) + name=trim(attName), value=varr8val, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (trim(attName) == 'dtp') then wrt_int_state%dtp=varr8val @@ -318,7 +318,7 @@ subroutine post_getattr_gfs(wrt_int_state) if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) + name=trim(attName), valueList=wrt_int_state%bk, rc=rc) endif wrt_int_state%lm = size(wrt_int_state%ak) - 1 endif From 7eaae733e77e1cd34ed76d0a864a0d11d5ce081b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 5 Oct 2021 19:07:32 +0000 Subject: [PATCH 207/217] updated .gitmodules --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index a3e9ea21d..a09675561 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,4 +9,4 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Jul302021 + branch = SM_Sep142021 From e08c4e90fc8c394bd70c86acf261ebff4627c2a1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 8 Oct 2021 09:32:31 -0600 Subject: [PATCH 208/217] Add guard for unsupported combination of cplflx and cplice to GFS_typedefs.F90) --- ccpp/data/GFS_typedefs.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index bc21575c1..44bcd4fd0 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -633,7 +633,7 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection - logical :: cplice !< default yes cplice collection (used together with cplflx) + logical :: cplice !< default no cplice collection (used together with cplflx) logical :: cplocn2atm !< default yes ocn->atm coupling logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling @@ -3106,7 +3106,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection - logical :: cplice = .true. !< default yes cplice collection (used together with cplflx) + logical :: cplice = .false. !< default no cplice collection (used together with cplflx) logical :: cplocn2atm = .true. !< default yes cplocn2atm coupling (turn on the feedback from ocn to atm) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling @@ -3856,6 +3856,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx Model%cplice = cplice + ! Consistency check, currently allowed combinations are + ! Model%cplflx == .false. and Model%cplice == .false. (uncoupled runs) + ! Model%cplflx == .true. and Model%cplice == .true. (coupled S2S runs) + ! Model%cplflx == .true. and Model%cplice == .false. (HAFS FV3ATM-HYCOM) + if (Model%cplice .and. .not. Model%cplflx) then + print *,' Logic error: Model%cplflx==.false. and Model%cplice==.true. is currently not supported - shutting down' + stop + endif Model%cplocn2atm = cplocn2atm Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm From 6512959bc94105e35ffde9a6977ca20441cc4e4c Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 9 Oct 2021 21:03:16 -0400 Subject: [PATCH 209/217] reverting post_gfs to develop version --- io/post_gfs.F90 | 31 ------------------------------- 1 file changed, 31 deletions(-) diff --git a/io/post_gfs.F90 b/io/post_gfs.F90 index 0a8b2ab12..105172a86 100644 --- a/io/post_gfs.F90 +++ b/io/post_gfs.F90 @@ -246,7 +246,6 @@ subroutine post_getattr_gfs(wrt_int_state) fldbundle = wrt_int_state%wrtFB(nfb) ! look at the field bundle attributes -<<<<<<< HEAD call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -254,14 +253,6 @@ subroutine post_getattr_gfs(wrt_int_state) ! aklen=0. do i=1, attCount -======= - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__))return -! - aklen = 0. - do i=1, attCount ->>>>>>> 99eb1d2c0a68013f05608bfb49ff7429abdfa2cb call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & @@ -316,7 +307,6 @@ subroutine post_getattr_gfs(wrt_int_state) if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) allocate(wrt_int_state%ak(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & -<<<<<<< HEAD name=trim(attName), valueList=wrt_int_state%ak, rc=rc) wrt_int_state%lm = n-1 else if(trim(attName) =="bk") then @@ -324,27 +314,6 @@ subroutine post_getattr_gfs(wrt_int_state) allocate(wrt_int_state%bk(n)) call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attName), valueList=wrt_int_state%bk, rc=rc) -======= - name=trim(attName), value=varr8val, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr8val - endif - else if(n > 1) then - if(trim(attName) == "ak") then - if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) - allocate(wrt_int_state%ak(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%ak, rc=rc) - wrt_int_state%lm = n-1 - else if(trim(attName) =="bk") then - if(allocated(wrt_int_state%bk)) deallocate(wrt_int_state%bk) - allocate(wrt_int_state%bk(n)) - call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & - name=trim(attName), valueList=wrt_int_state%bk, rc=rc) - endif - wrt_int_state%lm = size(wrt_int_state%ak) - 1 ->>>>>>> 99eb1d2c0a68013f05608bfb49ff7429abdfa2cb endif wrt_int_state%lm = size(wrt_int_state%ak) - 1 endif From a50c5dcb7081f23c03c1b79c6788b16492d93927 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 10 Oct 2021 21:05:34 -0400 Subject: [PATCH 210/217] fixing FV3GFS_io.F90 --- io/FV3GFS_io.F90 | 50 ++++++++++++++++-------------------------------- 1 file changed, 17 insertions(+), 33 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 22db8e344..88cd89a75 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -313,8 +313,10 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,89) = GFS_Data(nb)%Sfcprop%albdifvis_lnd(ix) temp2d(i,j,90) = GFS_Data(nb)%Sfcprop%albdifnir_lnd(ix) temp2d(i,j,91) = GFS_Data(nb)%Sfcprop%emis_lnd(ix) + temp2d(i,j,92) = GFS_Data(nb)%Sfcprop%emis_ice(ix) + temp2d(i,j,93) = GFS_Data(nb)%Sfcprop%sncovr_ice(ix) - idx_opt = 92 + idx_opt = 93 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%albdirvis_ice(ix) temp2d(i,j,idx_opt+2) = GFS_Data(nb)%Sfcprop%albdirnir_ice(ix) @@ -385,18 +387,12 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+6) = GFS_Data(nb)%Sfcprop%tsnow_ice(ix) temp2d(i,j,idx_opt+7) = GFS_Data(nb)%Sfcprop%snowfallac_land(ix) temp2d(i,j,idx_opt+8) = GFS_Data(nb)%Sfcprop%snowfallac_ice(ix) - temp2d(i,j,idx_opt+9) = GFS_Data(nb)%Sfcprop%sncovr_ice(ix) - temp2d(i,j,idx_opt+10) = GFS_Data(nb)%Sfcprop%sfalb_lnd(ix) - temp2d(i,j,idx_opt+11) = GFS_Data(nb)%Sfcprop%sfalb_lnd_bck(ix) -! temp2d(i,j,idx_opt+16) = GFS_Data(nb)%Sfcprop%albdirvis_ice(ix) -! temp2d(i,j,idx_opt+17) = GFS_Data(nb)%Sfcprop%albdirnir_ice(ix) -! temp2d(i,j,idx_opt+18) = GFS_Data(nb)%Sfcprop%albdifvis_ice(ix) -! temp2d(i,j,idx_opt+19) = GFS_Data(nb)%Sfcprop%albdifnir_ice(ix) - temp2d(i,j,idx_opt+12) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) - temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%emis_ice(ix) - idx_opt = idx_opt + 14 + temp2d(i,j,idx_opt+9) = GFS_Data(nb)%Sfcprop%sfalb_lnd(ix) + temp2d(i,j,idx_opt+10) = GFS_Data(nb)%Sfcprop%sfalb_lnd_bck(ix) + temp2d(i,j,idx_opt+11) = GFS_Data(nb)%Sfcprop%sfalb_ice(ix) + idx_opt = idx_opt + 11 if (Model%rdlai) then - temp2d(i,j,idx_opt+23) = GFS_Data(nb)%Sfcprop%xlaixy(ix) + temp2d(i,j,idx_opt+1) = GFS_Data(nb)%Sfcprop%xlaixy(ix) idx_opt = idx_opt + 1 endif endif @@ -531,9 +527,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%lsm == Model%lsm_ruc .and. warm_start) then if(Model%rdlai) then - nvar_s2r = 15 + nvar_s2r = 13 else - nvar_s2r = 14 + nvar_s2r = 12 end if nvar_s3 = 5 else @@ -1651,9 +1647,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2o = 18 if (Model%lsm == Model%lsm_ruc) then if (Model%rdlai) then - nvar2r = 15 + nvar2r = 13 else - nvar2r = 14 + nvar2r = 12 endif nvar3 = 5 else @@ -1836,11 +1832,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(46) = 'sncovr_ice' if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - sfc_name2(45) = 'albdirvis_ice' - sfc_name2(46) = 'albdifvis_ice' - sfc_name2(47) = 'albdirnir_ice' - sfc_name2(48) = 'albdifnir_ice' -! sfc_name2(49) = 'sfalb_ice' + sfc_name2(47) = 'albdirvis_ice' + sfc_name2(48) = 'albdifvis_ice' + sfc_name2(49) = 'albdirnir_ice' + sfc_name2(50) = 'albdifnir_ice' +! sfc_name2(51) = 'sfalb_ice' endif if (Model%cplwav) then @@ -1875,15 +1871,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+25) = 'tsnow_ice' sfc_name2(nvar2m+26) = 'snowfall_acc_land' sfc_name2(nvar2m+27) = 'snowfall_acc_ice' -! sfc_name2(nvar2m+28) = 'sncovr_ice' sfc_name2(nvar2m+28) = 'sfalb_lnd' sfc_name2(nvar2m+29) = 'sfalb_lnd_bck' -! sfc_name2(nvar2m+31) = 'albdirvis_ice' -! sfc_name2(nvar2m+32) = 'albdirnir_ice' -! sfc_name2(nvar2m+33) = 'albdifvis_ice' -! sfc_name2(nvar2m+34) = 'albdifnir_ice' sfc_name2(nvar2m+30) = 'sfalb_ice' -! sfc_name2(nvar2m+32) = 'emis_ice' if (Model%rdlai) then sfc_name2(nvar2m+31) = 'lai' endif @@ -2123,15 +2113,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+25) = Sfcprop(nb)%tsnow_ice(ix) sfc_var2(i,j,nvar2m+26) = Sfcprop(nb)%snowfallac_land(ix) sfc_var2(i,j,nvar2m+27) = Sfcprop(nb)%snowfallac_ice(ix) -! sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sncovr_ice(ix) sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+29) = Sfcprop(nb)%sfalb_lnd_bck(ix) -! sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%albdirvis_ice(ix) -! sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%albdirnir_ice(ix) -! sfc_var2(i,j,nvar2m+33) = Sfcprop(nb)%albdifvis_ice(ix) -! sfc_var2(i,j,nvar2m+34) = Sfcprop(nb)%albdifnir_ice(ix) sfc_var2(i,j,nvar2m+30) = Sfcprop(nb)%sfalb_ice(ix) -! sfc_var2(i,j,nvar2m+32) = Sfcprop(nb)%emis_ice(ix) if (Model%rdlai) then sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%xlaixy(ix) endif From 04b926d1a55a88f186905f2184ea2a623fedb8d5 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 15 Oct 2021 16:19:11 +0000 Subject: [PATCH 211/217] additional updates to emissivity calculation etc --- atmos_cubed_sphere | 2 +- ccpp/data/GFS_typedefs.F90 | 18 +++++++---- ccpp/data/GFS_typedefs.meta | 28 ++++++++--------- ccpp/framework | 2 +- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 61 ++++++++++++++++++++++--------------- 6 files changed, 65 insertions(+), 48 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 640636614..ab026b794 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 6406366144dab2b83e1833962577ef8c968cd92d +Subproject commit ab026b79497ee00530ff3eb6b59dd9b9346e8e7d diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index c47d44954..e4aeeb544 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -241,6 +241,8 @@ module GFS_typedefs real (kind=kind_phys), pointer :: fice (:) => null() !< ice fraction over open water grid real (kind=kind_phys), pointer :: snodl (:) => null() !< snow depth over land real (kind=kind_phys), pointer :: weasdl (:) => null() !< weasd over land + real (kind=kind_phys), pointer :: snodi (:) => null() !< snow depth over ice + real (kind=kind_phys), pointer :: weasdi (:) => null() !< weasd over ice ! real (kind=kind_phys), pointer :: hprim (:) => null() !< topographic standard deviation in m real (kind=kind_phys), pointer :: hprime (:,:) => null() !< orographic metrics real (kind=kind_phys), pointer :: z0base (:) => null() !< background or baseline surface roughness length in m @@ -2034,7 +2036,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: smcmax(:) => null() !< real (kind=kind_phys), pointer :: smc_save(:,:) => null() !< real (kind=kind_phys), pointer :: snowc(:) => null() !< - real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< +! real (kind=kind_phys), pointer :: snowd_ice(:) => null() !< real (kind=kind_phys), pointer :: snowd_land_save(:) => null() !< real (kind=kind_phys), pointer :: snow_depth(:) => null() !< real (kind=kind_phys), pointer :: snohf(:) => null() !< @@ -2085,7 +2087,7 @@ module GFS_typedefs ! real (kind=kind_phys), pointer :: weasd_water(:) => null() !< ! real (kind=kind_phys), pointer :: weasd_land(:) => null() !< real (kind=kind_phys), pointer :: weasd_land_save(:) => null() !< - real (kind=kind_phys), pointer :: weasd_ice(:) => null() !< +! real (kind=kind_phys), pointer :: weasd_ice(:) => null() !< real (kind=kind_phys), pointer :: wind(:) => null() !< real (kind=kind_phys), pointer :: work1(:) => null() !< real (kind=kind_phys), pointer :: work2(:) => null() !< @@ -2363,6 +2365,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%fice (IM)) allocate (Sfcprop%snodl (IM)) allocate (Sfcprop%weasdl (IM)) + allocate (Sfcprop%snodi (IM)) + allocate (Sfcprop%weasdi (IM)) ! allocate (Sfcprop%hprim (IM)) allocate (Sfcprop%hprime (IM,Model%nmtvr)) allocate(Sfcprop%albdirvis_lnd (IM)) @@ -2391,6 +2395,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%fice = clear_val Sfcprop%snodl = clear_val Sfcprop%weasdl = clear_val + Sfcprop%snodi = clear_val + Sfcprop%weasdi = clear_val ! Sfcprop%hprim = clear_val Sfcprop%hprime = clear_val Sfcprop%albdirvis_lnd = clear_val @@ -7097,7 +7103,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%sigmafrac (IM,Model%levs)) allocate (Interstitial%sigmatot (IM,Model%levs)) allocate (Interstitial%snowc (IM)) - allocate (Interstitial%snowd_ice (IM)) +! allocate (Interstitial%snowd_ice (IM)) allocate (Interstitial%snohf (IM)) allocate (Interstitial%snowmt (IM)) allocate (Interstitial%stress (IM)) @@ -7126,7 +7132,7 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%vdftra (IM,Model%levs,Interstitial%nvdiff)) !GJF first dimension was set as 'IX' in GFS_physics_driver allocate (Interstitial%vegf1d (IM)) allocate (Interstitial%wcbmax (IM)) - allocate (Interstitial%weasd_ice (IM)) +! allocate (Interstitial%weasd_ice (IM)) ! allocate (Interstitial%weasd_land (IM)) ! allocate (Interstitial%weasd_water (IM)) allocate (Interstitial%wind (IM)) @@ -7826,7 +7832,7 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%sigmafrac = clear_val Interstitial%sigmatot = clear_val Interstitial%snowc = clear_val - Interstitial%snowd_ice = Model%huge +! Interstitial%snowd_ice = Model%huge Interstitial%snohf = clear_val Interstitial%snowmt = clear_val Interstitial%stress = clear_val @@ -7852,7 +7858,7 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%vegf1d = clear_val Interstitial%lndp_vgf = clear_val Interstitial%wcbmax = clear_val - Interstitial%weasd_ice = Model%huge +! Interstitial%weasd_ice = Model%huge ! Interstitial%weasd_land = Model%huge ! Interstitial%weasd_water = Model%huge Interstitial%wind = Model%huge diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index c54fb3fa3..40ea9cb7f 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -592,6 +592,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[snodi] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdi] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [hprime] standard_name = statistical_measures_of_subgrid_orography_collection_array long_name = orographic metrics @@ -9530,13 +9544,6 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[snowd_ice] - standard_name = surface_snow_thickness_water_equivalent_over_ice - long_name = water equivalent snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [snowd_land_save] standard_name = surface_snow_thickness_water_equivalent_over_land_save long_name = water equivalent snow depth over land before entering a physics scheme @@ -9869,13 +9876,6 @@ type = real kind = kind_phys active = (control_for_land_surface_scheme == identifier_for_noah_wrfv4_land_surface_scheme) -[weasd_ice] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level diff --git a/ccpp/framework b/ccpp/framework index 6874fc9b4..bc1826932 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 6874fc9b49237b70df7af9b513ea10df697c27d6 +Subproject commit bc18269320395826896072308f3d50cf056880ff diff --git a/ccpp/physics b/ccpp/physics index 44d497415..e7dfdefe9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 44d497415dcaba4dc693173f27395474b81d2a1f +Subproject commit e7dfdefe90cc2db965faba2f0dc8e5d145cc1f26 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 88cd89a75..f0f82d264 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -653,7 +653,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo enddo - nvar_s2m = 46 + nvar_s2m = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar_s2m = nvar_s2m + 4 ! nvar_s2m = nvar_s2m + 5 @@ -842,13 +842,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(44) = 'emis_lnd' sfc_name2(45) = 'emis_ice' sfc_name2(46) = 'sncovr_ice' + sfc_name2(47) = 'snodi' ! snowd on ice portion of a cell + sfc_name2(48) = 'weasdi'! weasd on ice portion of a cell if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - sfc_name2(47) = 'albdirvis_ice' - sfc_name2(48) = 'albdifvis_ice' - sfc_name2(49) = 'albdirnir_ice' - sfc_name2(50) = 'albdifnir_ice' -! sfc_name2(51) = 'sfalb_ice' + sfc_name2(49) = 'albdirvis_ice' + sfc_name2(50) = 'albdifvis_ice' + sfc_name2(51) = 'albdirnir_ice' + sfc_name2(52) = 'albdifnir_ice' +! sfc_name2(53) = 'sfalb_ice' endif if(Model%cplwav) then @@ -963,6 +965,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (trim(sfc_name2(num)) == 'sncovr'.or. trim(sfc_name2(num)) == 'tsfcl' .or. trim(sfc_name2(num)) == 'zorll' & .or. trim(sfc_name2(num)) == 'zorli' .or. trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'snodi' .or. trim(sfc_name2(num)) == 'weasdi' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & @@ -1165,12 +1168,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%emis_lnd(ix) = sfc_var2(i,j,44) Sfcprop(nb)%emis_ice(ix) = sfc_var2(i,j,45) Sfcprop(nb)%sncovr_ice(ix) = sfc_var2(i,j,46) + Sfcprop(nb)%snodi(ix) = sfc_var2(i,j,47) !--- snodi (snowd on ice portion of a cell) + Sfcprop(nb)%weasdi(ix) = sfc_var2(i,j,48) !--- weasdi (weasd on ice portion of a cell) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,47) - Sfcprop(nb)%albdifvis_ice(ix) = sfc_var2(i,j,48) - Sfcprop(nb)%albdirnir_ice(ix) = sfc_var2(i,j,49) - Sfcprop(nb)%albdifnir_ice(ix) = sfc_var2(i,j,50) -! Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,51) + Sfcprop(nb)%albdirvis_ice(ix) = sfc_var2(i,j,49) + Sfcprop(nb)%albdifvis_ice(ix) = sfc_var2(i,j,50) + Sfcprop(nb)%albdirnir_ice(ix) = sfc_var2(i,j,51) + Sfcprop(nb)%albdifnir_ice(ix) = sfc_var2(i,j,52) +! Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,53) endif if(Model%cplwav) then Sfcprop(nb)%zorlwav(ix) = sfc_var2(i,j,nvar_s2m) !--- (zorl from wave model) @@ -1517,18 +1522,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif - if (sfc_var2(i,j,46) < -9990.0_r8) then + if (sfc_var2(i,j,46) < -9990.0_r8 .and. Model%lsm /= Model%lsm_ruc) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr_ice') !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) - Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) +! Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) + Sfcprop(nb)%sncovr_ice(ix) = zero enddo enddo endif if (Model%use_cice_alb) then - if (sfc_var2(i,j,47) < -9990.0_r8) then + if (sfc_var2(i,j,49) < -9990.0_r8) then !$omp parallel do default(shared) private(nb, ix) do nb = 1, Atm_block%nblks do ix = 1, Atm_block%blksz(nb) @@ -1638,7 +1644,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: is, ie integer, allocatable, dimension(:) :: buffer - nvar2m = 46 + nvar2m = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then nvar2m = nvar2m + 4 ! nvar2m = nvar2m + 5 @@ -1830,13 +1836,15 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(44) = 'emis_lnd' sfc_name2(45) = 'emis_ice' sfc_name2(46) = 'sncovr_ice' + sfc_name2(47) = 'snodi' !snowd on ice portion of a cell + sfc_name2(48) = 'weasdi'!weasd on ice portion of a cell if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - sfc_name2(47) = 'albdirvis_ice' - sfc_name2(48) = 'albdifvis_ice' - sfc_name2(49) = 'albdirnir_ice' - sfc_name2(50) = 'albdifnir_ice' -! sfc_name2(51) = 'sfalb_ice' + sfc_name2(49) = 'albdirvis_ice' + sfc_name2(50) = 'albdifvis_ice' + sfc_name2(51) = 'albdirnir_ice' + sfc_name2(52) = 'albdifnir_ice' +! sfc_name2(53) = 'sfalb_ice' endif if (Model%cplwav) then @@ -1917,6 +1925,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (trim(sfc_name2(num)) == 'sncovr' .or. trim(sfc_name2(num)) == 'tsfcl' .or.trim(sfc_name2(num)) == 'zorll' & .or. trim(sfc_name2(num)) == 'zorli' .or.trim(sfc_name2(num)) == 'zorlwav' & .or. trim(sfc_name2(num)) == 'snodl' .or. trim(sfc_name2(num)) == 'weasdl' & + .or. trim(sfc_name2(num)) == 'snodi' .or. trim(sfc_name2(num)) == 'weasdi' & .or. trim(sfc_name2(num)) == 'tsfc' .or. trim(sfc_name2(num)) == 'zorlw' & .or. trim(sfc_name2(num)) == 'albdirvis_lnd' .or. trim(sfc_name2(num)) == 'albdirnir_lnd' & .or. trim(sfc_name2(num)) == 'albdifvis_lnd' .or. trim(sfc_name2(num)) == 'albdifnir_lnd' & @@ -2070,12 +2079,14 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,44) = Sfcprop(nb)%emis_lnd(ix) sfc_var2(i,j,45) = Sfcprop(nb)%emis_ice(ix) sfc_var2(i,j,46) = Sfcprop(nb)%sncovr_ice(ix) + sfc_var2(i,j,47) = Sfcprop(nb)%snodi(ix) !--- snodi (snowd on ice) + sfc_var2(i,j,48) = Sfcprop(nb)%weasdi(ix) !--- weasdi (weasd on ice) if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then - sfc_var2(i,j,47) = Sfcprop(nb)%albdirvis_ice(ix) - sfc_var2(i,j,48) = Sfcprop(nb)%albdifvis_ice(ix) - sfc_var2(i,j,49) = Sfcprop(nb)%albdirnir_ice(ix) - sfc_var2(i,j,50) = Sfcprop(nb)%albdifnir_ice(ix) -! sfc_var2(i,j,51) = Sfcprop(nb)%sfalb_ice(ix) + sfc_var2(i,j,49) = Sfcprop(nb)%albdirvis_ice(ix) + sfc_var2(i,j,50) = Sfcprop(nb)%albdifvis_ice(ix) + sfc_var2(i,j,51) = Sfcprop(nb)%albdirnir_ice(ix) + sfc_var2(i,j,52) = Sfcprop(nb)%albdifnir_ice(ix) +! sfc_var2(i,j,53) = Sfcprop(nb)%sfalb_ice(ix) endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) From 2487d45032bd1c638d18fa358ca561780129b1ed Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 18 Oct 2021 14:32:45 +0000 Subject: [PATCH 212/217] after syncing with ccpp branch --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index e7dfdefe9..7c1b474bd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e7dfdefe90cc2db965faba2f0dc8e5d145cc1f26 +Subproject commit 7c1b474bd0de3e048794d191c248563a5c708952 From fd5f5ff7caed62c6589a0680fb6bf71bea5fa7be Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 19 Oct 2021 16:18:35 +0000 Subject: [PATCH 213/217] after updating atmos_cuber_sphere pointer --- atmos_cubed_sphere | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index ab026b794..02c3bac34 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit ab026b79497ee00530ff3eb6b59dd9b9346e8e7d +Subproject commit 02c3bac346792e9e974b55f256465138a9f69d8e diff --git a/ccpp/physics b/ccpp/physics index 7c1b474bd..bc6a7c300 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7c1b474bd0de3e048794d191c248563a5c708952 +Subproject commit bc6a7c3006cc58bac76e6cf7b04fdd5207a239b0 From 4e8d640de8ebc6d41a9d1a51c11af7c8cd6de64e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 19 Oct 2021 17:32:12 +0000 Subject: [PATCH 214/217] updating pointer to ccpp framework --- ccpp/framework | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/framework b/ccpp/framework index bc1826932..6874fc9b4 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit bc18269320395826896072308f3d50cf056880ff +Subproject commit 6874fc9b49237b70df7af9b513ea10df697c27d6 From 1800bff1f6c4e372ee55e87d53001301ccfba16e Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 20 Oct 2021 18:50:39 -0400 Subject: [PATCH 215/217] after syncing --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index bc6a7c300..6c0183e6c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit bc6a7c3006cc58bac76e6cf7b04fdd5207a239b0 +Subproject commit 6c0183e6c6ff6459caf297498b4819d36625d94b From 16155471153a06874b207a29f8f28a17185ac943 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 22 Oct 2021 11:11:41 +0000 Subject: [PATCH 216/217] updating ccpp pointer to main --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 6c0183e6c..b12e6c328 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 6c0183e6c6ff6459caf297498b4819d36625d94b +Subproject commit b12e6c3280804fe04e4256654c35602cc930d5cd From 4901e89e413860873da054f526c86dc718261c96 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 22 Oct 2021 12:31:06 +0000 Subject: [PATCH 217/217] updating .gitmodules --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 70a151834..a54f243ae 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,5 +8,5 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SMoorthi-emc/ccpp-physics - branch = SM_Sept21_PR + url = https://github.com/NCAR/ccpp-physics + branch = main