From 89e9a4ff76045aa4e89ab0ad4f6f99d40bb5a9a1 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 10 Feb 2022 21:27:29 +0000 Subject: [PATCH 01/72] Initial commit of rrfs_cmaq_canopy branch. --- README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README b/README index 8b13789..d1a50ac 100644 --- a/README +++ b/README @@ -1 +1 @@ - +Modified branch to account for in-canopy effects on composition/weather From e38abcd13ce1196f01235c0dd198e123263eea0f Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Fri, 11 Feb 2022 20:06:04 +0000 Subject: [PATCH 02/72] Initial copy of canopy photolysis routines. --- src/model/src/ASX_DATA_MOD.F | 1395 ++++++++++++++ src/model/src/PHOT_MOD.F | 1898 ++++++++++++++++++++ src/model/src/centralized_io_util_module.F | 282 +++ src/model/src/phot.F | 1251 +++++++++++++ 4 files changed, 4826 insertions(+) create mode 100755 src/model/src/ASX_DATA_MOD.F create mode 100644 src/model/src/PHOT_MOD.F create mode 100644 src/model/src/centralized_io_util_module.F create mode 100644 src/model/src/phot.F diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F new file mode 100755 index 0000000..8cad21f --- /dev/null +++ b/src/model/src/ASX_DATA_MOD.F @@ -0,0 +1,1395 @@ +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module ASX_DATA_MOD + +C----------------------------------------------------------------------- +C Function: User-defined types + +C Revision History: +C 19 Aug 2014 J.Bash: initial implementation +C 17 July 2015 H.Foroutan: Updated the calculation of MOL, MOLI, HOL, and WSTAR +C 25 Aug 2015 H. Pye: Added IEPOX, HACET surrogates +C modified PROPNN and H2O2 +C Increased ar for ozone from 8 to 12. +C Change meso from 0.1 to 0 for some org. nitrates +C Changes based on Nguyen et al. 2015 PNAS and SOAS +C +C---------Notes +C * Updates based on literature review 7/96 JEP +C # Diff and H based on Wesely (1988) same as RADM +C + Estimated by JEP 2/97 +C @ Updated by JEP 9/01 +C ~ Added by YW 1/02. Dif0 based on Massman (1998). Henry's Law constant +C is defined here as: h=cg/ca, where cg is the concentration of a species +C in gas-phase, and ca is its aqueous-phase concentration. The smaller h, +C the larger solubility. Henry's Law constant in another definition (KH): +C KH = ca/pg [M/atm], KH = KH0 * exp(-DKH/R(1/T-1/T0)), where KH0 and -DKH +C values are from Rolf Sander (1999). h=1/(KH*R*T). +C ** Update by DBS based on estimates by JEP 1/03 +C ^^ From Bill Massman, personal communication 4/03 +C ## Diffusivity calculated by SPARC, reactivity = other aldehydes +C ++ Dif0 in Massman is diffusivity at temperature 0C and 1 atm (101.325kPa), so +C chemicals that were not in Massman's paper need to be adjusted. We assume +C JEP's original values were for 25C and 1 atm. +C % Added by G. Sarwar (10/04) +C $ Added by R. Bullock (02/05) HG diffusivity is from Massman (1999). +C HGIIGAS diffusivity calculated from the HG value and a mol. wt. scaling +C factor of MW**(-2/3) from EPA/600/3-87/015. ORD, Athens, GA. HGIIGAS +C mol.wt. used is that of HgCl2. Reactivity of HG is 1/20th of NO and NO2 +C values based on general atmospheric lifetimes of each species. Reactivity +C of HGIIGAS is based on HNO3 surrogate. +C @@ Mesophyll resistances for NO, NO2, and CO added by J. Pleim (07/07) based +C on values in Pleim, Venkatram, and Yamartino, 1984: ADOM/TADAP Model +C Development Program, Volume 4, The Dry Deposition Module. ERT, Inc., +C Concord, MA (peer reviewed). +C ~~ Reactivity for PAN changed from 4.0 to 16.0 by J. Pleim (07/07) based on +C comparisons with Turnipseed et al., JGR, 2006. +C %% Species ICL1 and ICL2 are removed, not used in CB05. G. Sarwar (07/07) +C <> Hazardous Air Pollutants that are believed to undergo significant dry +C deposition. Hydrazine and triethylamine reactivities are based on analogies +C to NH3. Maleic anhydride reactivity is assumed similar to aldehydes. +C Toluene diisocyanate and hexamethylene diisocyanate reactivities are +C assumed to be similar to SO2. Diffusivities are calculated with standard +C formulas. W. Hutzell (04/08) +C %% G. Sarwar: added data for iodine and bromine species (03/2016) +C %% B. Hutzell: added dry deposition data for methane, acrylic acid, methyl chloride, +C and acetonitrile (09/2016) +C------------------------------------------------------------------------------- + + Use GRID_CONF ! horizontal & vertical domain specifications + Use LSM_MOD ! Land surface data + Use DEPVVARS, Only: ltotg + + Implicit None + + Include SUBST_CONST ! constants + + Type :: MET_Type +!> 2-D meteorological fields: + Real, Allocatable :: RDEPVHT ( :,: ) ! air dens / dep vel ht + Real, Allocatable :: DENS1 ( :,: ) ! layer 1 air density + Real, Allocatable :: PRSFC ( :,: ) ! surface pressure [Pa] + Real, Allocatable :: Q2 ( :,: ) ! 2 meter water vapor mixing ratio [kg/kg] + Real, Allocatable :: QSS_GRND ( :,: ) ! ground saturation water vapor mixing ratio [kg/kg] + Real, Allocatable :: RH ( :,: ) ! relative humidity [ratio] + Real, Allocatable :: RA ( :,: ) ! aerodynamic resistnace [s/m] + Real, Allocatable :: RS ( :,: ) ! stomatal resistnace [s/m] + Real, Allocatable :: RC ( :,: ) ! convective precipitation [cm] + Real, Allocatable :: RN ( :,: ) ! non-convective precipitation [mc] + Real, Allocatable :: RGRND ( :,: ) ! Solar radiation at the ground [W/m**2] + Real, Allocatable :: HFX ( :,: ) ! Sensible heat flux [W/m**2] + Real, Allocatable :: LH ( :,: ) ! Latent heat flux [W/m**2] + Real, Allocatable :: SNOCOV ( :,: ) ! Snow cover [1=yes, 0=no] + Real, Allocatable :: TEMP2 ( :,: ) ! two meter temperature [K] + Real, Allocatable :: TEMPG ( :,: ) ! skin temperature [K] + Real, Allocatable :: TSEASFC ( :,: ) ! SST [K] + Real, Allocatable :: USTAR ( :,: ) ! surface friction velocity [m/s] + Real, Allocatable :: VEG ( :,: ) ! fractional vegetation coverage [ratio] + Real, Allocatable :: LAI ( :,: ) ! grid cell leaf area index [m**2/m**2] + Real, Allocatable :: WR ( :,: ) ! precip intercepted by canopy [m] + Real, Allocatable :: WSPD10 ( :,: ) ! 10-m wind speed [m/s] + Real, Allocatable :: WSTAR ( :,: ) ! convective velocity scale [m/s] + Real, Allocatable :: Z0 ( :,: ) ! roughness length [m] + Real, Allocatable :: SOIM1 ( :,: ) ! 1 cm soil moisture [m**3/m**3] + Real, Allocatable :: SOIM2 ( :,: ) ! 1 m soil moisture [m**3/m**3] + Real, Allocatable :: SOIT1 ( :,: ) ! 1 cm soil temperature [K] + Real, Allocatable :: SOIT2 ( :,: ) ! 1 m soil temperature [K] + Real, Allocatable :: SEAICE ( :,: ) ! Sea ice coverage [%] + Real, Allocatable :: MOL ( :,: ) ! Monin-Obukhov length [m] + Real, Allocatable :: MOLI ( :,: ) ! inverse of Monin-Obukhov length [m] + Real, Allocatable :: HOL ( :,: ) ! PBL over Obukhov length + Real, Allocatable :: XPBL ( :,: ) ! PBL sigma height + Integer, Allocatable :: LPBL ( :,: ) ! PBL layer + Logical, Allocatable :: CONVCT ( :,: ) ! convection flag + Real, Allocatable :: PBL ( :,: ) ! pbl height (m) + Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) +!> U and V wind components on the cross grid points + Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] + Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] +!> 3-D meteorological fields: + Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s] + Real, Allocatable :: PRES ( :,:,: ) ! layer 1 pressure [Pa] + Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio + Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio + Real, Allocatable :: THETAV ( :,:,: ) ! potential temp + Real, Allocatable :: TA ( :,:,: ) ! temperature (K) + Real, Allocatable :: ZH ( :,:,: ) ! mid-layer height above ground [m] + Real, Allocatable :: ZF ( :,:,: ) ! layer height [m] + Real, Allocatable :: DZF ( :,:,: ) ! layer surface thickness + Real, Allocatable :: DENS ( :,:,: ) ! air density + Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian + Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian + Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian + End Type MET_Type + + Type :: GRID_Type +!> Grid infomation: +!> Vertical information + Real, Allocatable :: DX3F ( : ) ! sigma layer surface thickness ! vdiffacmx.F + Real, Allocatable :: RDX3F ( : ) ! reciprocal sigma layer thickness ! EMIS_DEFN.F, sedi.F, vdiffacmx.F, vdiffproc.F + Real, Allocatable :: RDX3M ( : ) ! reciprocal sigma midlayer thickness ! vdiffproc.F +!> Horizontal Information: + Real, Allocatable :: RMSFX4 ( :,: ) ! inverse map scale factor ** 4 + Real, Allocatable :: LON ( :,: ) ! longitude + Real, Allocatable :: LAT ( :,: ) ! latitude + Real, Allocatable :: LWMASK ( :,: ) ! land water mask + Real, Allocatable :: OCEAN ( :,: ) ! Open ocean + Real, Allocatable :: SZONE ( :,: ) ! Surf zone + Real, Allocatable :: PURB ( :,: ) ! percent urban [%] + Integer, Allocatable :: SLTYP ( :,: ) ! soil type [category] + Real, Allocatable :: WSAT ( :,: ) ! soil wilting point + Real, Allocatable :: WWLT ( :,: ) ! soil wilting point + Real, Allocatable :: BSLP ( :,: ) ! B Slope + Real, Allocatable :: WRES ( :,: ) ! Soil residual moisture point + Real, Allocatable :: WFC ( :,: ) ! soil field capacity +! Real, Allocatable :: RHOB ( :,: ) ! soil bulk density + Real, Allocatable :: LUFRAC ( :,:,: ) ! land use fraction (col,row,lu_type)[ratio] +C Land use information: + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. + End Type GRID_Type + + Type :: MOSAIC_Type ! (col,row,lu) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. +!> Sub grid cell meteorological variables: + Real, Allocatable :: USTAR ( :,:,: ) ! surface friction velocity [m/s] + Real, Allocatable :: LAI ( :,:,: ) ! leaf area index [m**2/m**2] + Real, Allocatable :: VEG ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: Z0 ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: DELTA ( :,:,: ) ! Surface wetness [ratio] +!> Sub grid cell resistances + Real, Allocatable :: RA ( :,:,: ) ! aerodynamic resistance [s/m] + Real, Allocatable :: RSTW ( :,:,: ) ! Stomatal Resistance of water [s/m] + Real, Allocatable :: RINC ( :,:,: ) ! In-canopy resistance [s/m] + End Type MOSAIC_Type + + Type :: ChemMos_Type ! (col,row,lu,spc) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: Lu_Type ( : ) ! general land use type e.g. water, forest, etc. + Character( 16 ), Allocatable :: SubName ( : ) ! Deposition species name +!> Sub grid cell chemically dependent resistances + Real, Allocatable :: Rb ( :,:,:,: ) ! quasi-laminar boundary layer resistance [s/m] + Real, Allocatable :: Rst ( :,:,:,: ) ! stomatal resistance [s/m] + Real, Allocatable :: Rgc ( :,:,:,: ) ! Canopy covered soil resistance [s/m] + Real, Allocatable :: Rgb ( :,:,:,: ) ! Barron soil resistance [s/m] + Real, Allocatable :: Rcut ( :,:,:,: ) ! soil resistance [s/m] + Real, Allocatable :: Rwat ( :,:,:,: ) ! surface water resistance [s/m] +!> Sub grid cell compensation point + Real, Allocatable :: Catm ( :,:,:,: ) ! Atmospheric [ppm] + Real, Allocatable :: CZ0 ( :,:,:,: ) ! compensation point at Z0 [ppm] + Real, Allocatable :: Cleaf( :,:,:,: ) ! Leaf compensation point [ppm] + Real, Allocatable :: Cstom( :,:,:,: ) ! Stomatal compensation point [ppm] + Real, Allocatable :: Ccut ( :,:,:,: ) ! Cuticular compensation point [ppm] + Real, Allocatable :: Csoil( :,:,:,: ) ! Soil compensation point [ppm] + End Type ChemMos_Type + + Type( MET_Type ), Save :: Met_Data + Type( GRID_Type ), Save :: Grid_Data + Type( MOSAIC_Type ), Save :: Mosaic_Data + Type( ChemMos_Type ), Save :: ChemMos_Data + + Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module +!> M3 asx constants + Real, Parameter :: a0 = 8.0 ! [dim'less] + Real, Parameter :: d3 = 1.38564e-2 ! [dim'less] + Real, Parameter :: dwat = 0.2178 ! [cm^2/s] at 273.15K + Real, Parameter :: hplus_ap = 1.0e-6 ! pH=6.0 leaf apoplast solution Ph (Massad et al 2008) + Real, Parameter :: hplus_def = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_east = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_h2o = 7.94328e-9 ! 10.0**(-8.1) + Real, Parameter :: hplus_west = 3.16228e-6 ! 10.0**(-5.5) + Real, Parameter :: kvis = 0.132 ! [cm^2 / s] at 273.15K + Real, Parameter :: pr = 0.709 ! [dim'less] + Real, Parameter :: rcut0 = 3000.0 ! [s/m] + Real, Parameter :: rcw0 = 125000.0 ! acc'd'g to Padro and + Real, Parameter :: resist_max = 1.0e30 ! maximum resistance + Real, Parameter :: rg0 = 1000.0 ! [s/m] + Real, Parameter :: rgwet0 = 25000.0 ! [s/m] + Real, Parameter :: rsndiff = 10.0 ! snow diffusivity fac + Real, Parameter :: rsnow0 = 1000.0 + Real, Parameter :: svp2 = 17.67 ! from MM5 and WRF + Real, Parameter :: svp3 = 29.65 ! from MM5 and WRF + Real, Parameter :: rt25inK = 1.0/(stdtemp + 25.0) ! 298.15K = 25C + Real, Parameter :: twothirds = 2.0 / 3.0 + Real, Parameter :: betah = 5.0 ! WRF 3.6 px uses Dyer + Real, Parameter :: gamah = 16.0 + Real, Parameter :: pr0 = 0.95 + Real, Parameter :: karman = 0.40 + Real, Parameter :: f3min = 0.25 + Real, Parameter :: ftmin = 0.0000001 ! m/s + Real, Parameter :: nscat = 16.0 + Real, Parameter :: rsmax = 5000.0 ! s/m + + Real :: ar ( ltotg ) ! reactivity relative to HNO3 + Real :: dif0 ( ltotg ) ! molecular diffusivity [cm2/s] + Real :: lebas ( ltotg ) ! Le Bas molar volume [cm3/mol ] + Real :: meso ( ltotg ) ! Exception for species that + ! react with cell walls. fo in + ! Wesely 1989 eq 6. + Character( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST + + Logical, Save :: MET_INITIALIZED = .false. + Real, Save :: CONVPA ! Pressure conversion factor file units to Pa + Logical, Save :: MINKZ + Logical, Save :: CSTAGUV ! Winds are available with C stagger? + Logical, Save :: ifwr = .false. + + Public :: INIT_MET + + Logical, Private, Save :: ifsst = .false. + Logical, Private, Save :: ifq2 = .false. + Logical, Private, Save :: rinv = .True. + Logical, Private, Save :: iflh = .false. + + Integer, Private :: C, R, L, S ! loop induction variables + Integer, Private :: SPC + Character( 16 ), Private, Save :: vname_rc, vname_rn, vname_uc, vname_vc + Real, Private, Save :: P0 ! reference pressure (100000.0 Pa) for Potential Temperature, note that in meteorology they do not use the SI 1 ATM. + + Integer, Private, Save :: LOGDEV + Integer, Private, Save :: GXOFF, GYOFF ! global origin offset from file + Integer, Private, Save :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ! MET_CRO_3D + Integer, Private, Save :: STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ! MET_DOT_3D + Integer, Private, Save :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ! MET_CRO_2D + Integer, Private, Save :: STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ! OCEAN_1 + + Real, Pointer, Private :: BUFF1D( : ) ! 1D temp var number of layers + Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var + Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var + + DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ + DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ + DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ + DATA subname( 4), dif0( 4), ar( 4), meso( 4), lebas( 4) / 'NO ', 0.1802, 2.0, 0.0, 14.0/ + DATA subname( 5), dif0( 5), ar( 5), meso( 5), lebas( 5) / 'O3 ', 0.1444, 12.0, 1.0, 21.0/ + DATA subname( 6), dif0( 6), ar( 6), meso( 6), lebas( 6) / 'HNO3 ', 0.1067, 8000.0, 0.0, 35.0/ + DATA subname( 7), dif0( 7), ar( 7), meso( 7), lebas( 7) / 'H2O2 ', 0.1300,34000.0, 1.0, 28.0/ !ar=34,000 such that r_cut=0.7 s/m as in Nguyen et al. 2015 + DATA subname( 8), dif0( 8), ar( 8), meso( 8), lebas( 8) / 'ACETALDEHYDE ', 0.1111, 10.0, 0.0, 56.0/ + DATA subname( 9), dif0( 9), ar( 9), meso( 9), lebas( 9) / 'FORMALDEHYDE ', 0.1554, 10.0, 0.0, 35.0/ + DATA subname( 10), dif0( 10), ar( 10), meso( 10), lebas( 10) / 'METHYLHYDROPEROX', 0.1179, 10.0, 0.3, 49.0/ !meso change from 0.1 to 0.3, Wolfe and Thornton 2011 ACP per J. Bash + DATA subname( 11), dif0( 11), ar( 11), meso( 11), lebas( 11) / 'PEROXYACETIC_ACI', 0.0868, 20.0, 0.1, 70.0/ + DATA subname( 12), dif0( 12), ar( 12), meso( 12), lebas( 12) / 'ACETIC_ACID ', 0.0944, 20.0, 0.0, 63.0/ + DATA subname( 13), dif0( 13), ar( 13), meso( 13), lebas( 13) / 'NH3 ', 0.1978, 20.0, 0.0, 28.0/ + DATA subname( 14), dif0( 14), ar( 14), meso( 14), lebas( 14) / 'PAN ', 0.0687, 16.0, 0.1, 91.0/ + DATA subname( 15), dif0( 15), ar( 15), meso( 15), lebas( 15) / 'HNO2 ', 0.1349, 20.0, 0.1, 28.0/ + DATA subname( 16), dif0( 16), ar( 16), meso( 16), lebas( 16) / 'CO ', 0.1807, 5.0, 0.0, 14.0/ + DATA subname( 17), dif0( 17), ar( 17), meso( 17), lebas( 17) / 'METHANOL ', 0.1329, 2.0, 0.0, 42.0/ + DATA subname( 18), dif0( 18), ar( 18), meso( 18), lebas( 18) / 'N2O5 ', 0.0808, 5000.0, 0.0, 49.0/ + DATA subname( 19), dif0( 19), ar( 19), meso( 19), lebas( 19) / 'NO3 ', 0.1153, 5000.0, 0.0, 28.0/ + DATA subname( 20), dif0( 20), ar( 20), meso( 20), lebas( 20) / 'GENERIC_ALDEHYDE', 0.0916, 10.0, 0.0, 56.0/ + DATA subname( 21), dif0( 21), ar( 21), meso( 21), lebas( 21) / 'CL2 ', 0.1080, 10.0, 0.0, 49.0/ + DATA subname( 22), dif0( 22), ar( 22), meso( 22), lebas( 22) / 'HOCL ', 0.1300, 10.0, 0.0, 38.5/ + DATA subname( 23), dif0( 23), ar( 23), meso( 23), lebas( 23) / 'HCL ', 0.1510, 8000.0, 0.0, 31.5/ + DATA subname( 24), dif0( 24), ar( 24), meso( 24), lebas( 24) / 'FMCL ', 0.1094, 10.0, 0.0, 45.5/ + DATA subname( 25), dif0( 25), ar( 25), meso( 25), lebas( 25) / 'HG ', 0.1194, 0.1, 0.0, 14.8/ ! lebas not used + DATA subname( 26), dif0( 26), ar( 26), meso( 26), lebas( 26) / 'HGIIGAS ', 0.0976, 8000.0, 0.0, 95.0/ ! estimation from back calculating to get dw25 = 1.04e-5 (Garland et al, 1965) + DATA subname( 27), dif0( 27), ar( 27), meso( 27), lebas( 27) / 'TECDD_2378 ', 0.0525, 2.0, 0.0, 217.0/ + DATA subname( 28), dif0( 28), ar( 28), meso( 28), lebas( 28) / 'PECDD_12378 ', 0.0508, 2.0, 0.0, 234.5/ + DATA subname( 29), dif0( 29), ar( 29), meso( 29), lebas( 29) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 30), dif0( 30), ar( 30), meso( 30), lebas( 30) / 'HXCDD_123678 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 31), dif0( 31), ar( 31), meso( 31), lebas( 31) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 32), dif0( 32), ar( 32), meso( 32), lebas( 32) / 'HPCDD_1234678 ', 0.0480, 2.0, 0.0, 269.5/ + DATA subname( 33), dif0( 33), ar( 33), meso( 33), lebas( 33) / 'OTCDD ', 0.0474, 2.0, 0.0, 287.0/ + DATA subname( 34), dif0( 34), ar( 34), meso( 34), lebas( 34) / 'TECDF_2378 ', 0.0534, 2.0, 0.0, 210.0/ + DATA subname( 35), dif0( 35), ar( 35), meso( 35), lebas( 35) / 'PECDF_12378 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 36), dif0( 36), ar( 36), meso( 36), lebas( 36) / 'PECDF_23478 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 37), dif0( 37), ar( 37), meso( 37), lebas( 37) / 'HXCDF_123478 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 38), dif0( 38), ar( 38), meso( 38), lebas( 38) / 'HXCDF_123678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 39), dif0( 39), ar( 39), meso( 39), lebas( 39) / 'HXCDF_234678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 40), dif0( 40), ar( 40), meso( 40), lebas( 40) / 'HXCDF_123789 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 41), dif0( 41), ar( 41), meso( 41), lebas( 41) / 'HPCDF_1234678 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 42), dif0( 42), ar( 42), meso( 42), lebas( 42) / 'HPCDF_1234789 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 43), dif0( 43), ar( 43), meso( 43), lebas( 43) / 'OTCDF ', 0.0474, 2.0, 0.0, 280.0/ + DATA subname( 44), dif0( 44), ar( 44), meso( 44), lebas( 44) / 'NAPHTHALENE ', 0.0778, 4.0, 0.0, 119.0/ + DATA subname( 45), dif0( 45), ar( 45), meso( 45), lebas( 45) / '1NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 46), dif0( 46), ar( 46), meso( 46), lebas( 46) / '2NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 47), dif0( 47), ar( 47), meso( 47), lebas( 47) / '14NAPHTHOQUINONE', 0.0780, 4.0, 0.0, 119.0/ + DATA subname( 48), dif0( 48), ar( 48), meso( 48), lebas( 48) / 'HEXAMETHYLE_DIIS', 0.0380, 10.0, 0.0, 196.0/ + DATA subname( 49), dif0( 49), ar( 49), meso( 49), lebas( 49) / 'HYDRAZINE ', 0.4164, 20.0, 0.0, 42.0/ + DATA subname( 50), dif0( 50), ar( 50), meso( 50), lebas( 50) / 'MALEIC_ANHYDRIDE', 0.0950, 10.0, 0.0, 70.0/ + DATA subname( 51), dif0( 51), ar( 51), meso( 51), lebas( 51) / '24-TOLUENE_DIIS ', 0.0610, 10.0, 0.0, 154.0/ + DATA subname( 52), dif0( 52), ar( 52), meso( 52), lebas( 52) / 'TRIETHYLAMINE ', 0.0881, 20.0, 0.0, 154.0/ + DATA subname( 53), dif0( 53), ar( 53), meso( 53), lebas( 53) / 'ORG_NTR ', 0.0607, 16.0, 0.0, 160.0/ ! assumes 58.2% C5H11O4N and 41.8% C5H11O3N + DATA subname( 54), dif0( 54), ar( 54), meso( 54), lebas( 54) / 'HYDROXY_NITRATES', 0.0609, 16.0, 0.0, 156.1/ + DATA subname( 55), dif0( 55), ar( 55), meso( 55), lebas( 55) / 'MPAN ', 0.0580, 16.0, 0.1, 133.0/ + DATA subname( 56), dif0( 56), ar( 56), meso( 56), lebas( 56) / 'PPN ', 0.0631, 16.0, 0.1, 118.2/ + DATA subname( 57), dif0( 57), ar( 57), meso( 57), lebas( 57) / 'MVK ', 0.0810, 8.0, 1.0, 88.8/ + DATA subname( 58), dif0( 58), ar( 58), meso( 58), lebas( 58) / 'DINTR ', 0.0617, 16.0, 0.1, 169.8/ + DATA subname( 59), dif0( 59), ar( 59), meso( 59), lebas( 59) / 'NTR_ALK ', 0.0688, 16.0, 0.1, 133.0/ + DATA subname( 60), dif0( 60), ar( 60), meso( 60), lebas( 60) / 'NTR_OH ', 0.0665, 16.0, 0.1, 140.4/ + DATA subname( 61), dif0( 61), ar( 61), meso( 61), lebas( 61) / 'HYDROXY_NITRATES', 0.0646, 16.0, 0.0, 147.8/ + DATA subname( 62), dif0( 62), ar( 62), meso( 62), lebas( 62) / 'PROPNN ', 0.0677, 16.0, 0.0, 133.0/ + DATA subname( 63), dif0( 63), ar( 63), meso( 63), lebas( 63) / 'NITRYL_CHLORIDE ', 0.0888, 8.0, 0.0, 45.5/ ! dif0 estimated following Erickson III et al., JGR, 104, D7, 8347-8372, 1999 + DATA subname( 64), dif0( 64), ar( 64), meso( 64), lebas( 64) / 'ISOPNN ',0.0457, 8.0, 0.0, 206.8/ + DATA subname( 65), dif0( 65), ar( 65), meso( 65), lebas( 65) / 'MTNO3 ',0.0453, 8.0, 0.0, 251.2/ + DATA subname( 66), dif0( 66), ar( 66), meso( 66), lebas( 66) / 'IEPOX ',0.0579, 8.0, 0.0, 110.8/ + DATA subname( 67), dif0( 67), ar( 67), meso( 67), lebas( 67) / 'HACET ',0.1060, 8.0, 0.0, 72.6/ ! dif0 from Nguyen 2015 PNAS + DATA subname( 68), dif0( 68), ar( 68), meso( 68), lebas( 68) / 'SVALK1 ',0.0514, 20.0, 0.0, 280.5/ + DATA subname( 69), dif0( 69), ar( 69), meso( 69), lebas( 69) / 'SVALK2 ',0.0546, 20.0, 0.0, 275.6/ + DATA subname( 70), dif0( 70), ar( 70), meso( 70), lebas( 70) / 'SVBNZ1 ',0.0642, 20.0, 0.0, 134.1/ + DATA subname( 71), dif0( 71), ar( 71), meso( 71), lebas( 71) / 'SVBNZ2 ',0.0726, 20.0, 0.0, 127.5/ + DATA subname( 72), dif0( 72), ar( 72), meso( 72), lebas( 72) / 'SVISO1 ',0.0733, 20.0, 0.0, 126.3/ + DATA subname( 73), dif0( 73), ar( 73), meso( 73), lebas( 73) / 'SVISO2 ',0.0729, 20.0, 0.0, 123.8/ + DATA subname( 74), dif0( 74), ar( 74), meso( 74), lebas( 74) / 'SVPAH1 ',0.0564, 20.0, 0.0, 235.7/ + DATA subname( 75), dif0( 75), ar( 75), meso( 75), lebas( 75) / 'SVPAH2 ',0.0599, 20.0, 0.0, 231.5/ + DATA subname( 76), dif0( 76), ar( 76), meso( 76), lebas( 76) / 'SVSQT ',0.0451, 20.0, 0.0, 346.5/ + DATA subname( 77), dif0( 77), ar( 77), meso( 77), lebas( 77) / 'SVTOL1 ',0.0637, 20.0, 0.0, 153.7/ + DATA subname( 78), dif0( 78), ar( 78), meso( 78), lebas( 78) / 'SVTOL2 ',0.0607, 20.0, 0.0, 194.1/ + DATA subname( 79), dif0( 79), ar( 79), meso( 79), lebas( 79) / 'SVTRP1 ',0.0603, 20.0, 0.0, 194.9/ + DATA subname( 80), dif0( 80), ar( 80), meso( 80), lebas( 80) / 'SVTRP2 ',0.0559, 20.0, 0.0, 218.8/ + DATA subname( 81), dif0( 81), ar( 81), meso( 81), lebas( 81) / 'SVXYL1 ',0.0610, 20.0, 0.0, 154.6/ + DATA subname( 82), dif0( 82), ar( 82), meso( 82), lebas( 82) / 'SVXYL2 ',0.0585, 20.0, 0.0, 194.6/ + DATA subname( 83), dif0( 83), ar( 83), meso( 83), lebas( 83) / 'IO ',0.1002, 8.0, 0.0, 44.4/ + DATA subname( 84), dif0( 84), ar( 84), meso( 84), lebas( 84) / 'OIO ',0.0938, 8.0, 0.0, 51.8/ + DATA subname( 85), dif0( 85), ar( 85), meso( 85), lebas( 85) / 'I2O2 ',0.0732, 8.0, 0.0, 88.8/ + DATA subname( 86), dif0( 86), ar( 86), meso( 86), lebas( 86) / 'I2O3 ',0.0707, 8.0, 0.0, 96.2/ + DATA subname( 87), dif0( 87), ar( 87), meso( 87), lebas( 87) / 'I2O4 ',0.0684, 8.0, 0.0, 103.6/ + DATA subname( 88), dif0( 88), ar( 88), meso( 88), lebas( 88) / 'HI ',0.1045, 8.0, 0.0, 40.7/ + DATA subname( 89), dif0( 89), ar( 89), meso( 89), lebas( 89) / 'HOI ',0.0972, 8.0, 0.0, 48.1/ + DATA subname( 90), dif0( 90), ar( 90), meso( 90), lebas( 90) / 'INO ',0.0882, 8.0, 0.0, 60.9/ + DATA subname( 91), dif0( 91), ar( 91), meso( 91), lebas( 91) / 'INO2 ',0.0883, 20.0, 0.0, 69.2/ + DATA subname( 92), dif0( 92), ar( 92), meso( 92), lebas( 92) / 'IONO2 ',0.0792, 8.0, 0.0, 77.5/ + DATA subname( 93), dif0( 93), ar( 93), meso( 93), lebas( 93) / 'BRO ',0.1144, 1.0, 0.0, 34.4/ + DATA subname( 94), dif0( 94), ar( 94), meso( 94), lebas( 94) / 'HOBR ',0.1101, 1.0, 0.0, 38.1/ + DATA subname( 95), dif0( 95), ar( 95), meso( 95), lebas( 95) / 'HBR ',0.1216, 2.0, 0.0, 30.7/ + DATA subname( 96), dif0( 96), ar( 96), meso( 96), lebas( 96) / 'BRONO2 ',0.0855, 1.0, 0.0, 67.5/ + DATA subname( 97), dif0( 97), ar( 97), meso( 97), lebas( 97) / 'BRNO2 ',0.0909, 1.0, 0.0, 59.2/ + DATA subname( 98), dif0( 98), ar( 98), meso( 98), lebas( 98) / 'BRCL ',0.0966, 1.0, 0.0, 51.6/ + DATA subname( 99), dif0( 99), ar( 99), meso( 99), lebas( 99) / 'DMS ',0.0926, 2.0, 0.0, 77.4/ + DATA subname(100), dif0(100), ar(100), meso(100), lebas(100) / 'MSA ',0.0896, 2.0, 0.0, 77.4/ + DATA subname(101), dif0(101), ar(101), meso(101), lebas(101) / 'METHANE ',0.2107, 2.0, 0.0, 29.6/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + DATA subname(102), dif0(102), ar(102), meso(102), lebas(102) / 'ACRYACID ',0.0908, 2.0, 0.0, 63.2/ + DATA subname(103), dif0(103), ar(103), meso(103), lebas(103) / 'CARBSULFIDE ',0.1240, 5.0, 0.0, 51.5/ + DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ + DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + + CONTAINS + +C======================================================================= + Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use UTILIO_DEFN + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_CONST ! constants + +C Arguments: + Integer, Intent( IN ) :: JDATE, JTIME ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C File variables: + Real, Pointer :: MSFX2 ( :,: ) + Real, Pointer :: SOILCAT ( :,: ) + Real, Pointer :: X3M ( : ) + +C Local variables: + Character( 16 ) :: PNAME = 'INIT_MET' + Character( 16 ) :: VNAME + CHARACTER( 16 ) :: UNITSCK + CHARACTER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C for INTERPX + Integer STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 + Integer V + Integer ALLOCSTAT + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + + If( MET_INITIALIZED )Return + +!> Allocate buffers + ALLOCATE ( BUFF1D( NLAYS ), + & BUFF2D( NCOLS,NROWS ), + & BUFF3D( NCOLS,NROWS,NLAYS ), STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Buffers' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + BUFF1D = 0.0 + BUFF2D = 0.0 + BUFF3D = 0.0 + +!> Allocate shared arrays +!> Met_Data + ALLOCATE( Met_Data%RDEPVHT ( NCOLS,NROWS ), + & Met_Data%DENS1 ( NCOLS,NROWS ), + & Met_Data%PRSFC ( NCOLS,NROWS ), + & Met_Data%Q2 ( NCOLS,NROWS ), + & Met_Data%QSS_GRND ( NCOLS,NROWS ), + & Met_Data%RH ( NCOLS,NROWS ), + & Met_Data%RA ( NCOLS,NROWS ), + & Met_Data%RS ( NCOLS,NROWS ), + & Met_Data%RC ( NCOLS,NROWS ), + & Met_Data%RN ( NCOLS,NROWS ), + & Met_Data%RGRND ( NCOLS,NROWS ), + & Met_Data%HFX ( NCOLS,NROWS ), + & Met_Data%LH ( NCOLS,NROWS ), + & Met_Data%SNOCOV ( NCOLS,NROWS ), + & Met_Data%TEMP2 ( NCOLS,NROWS ), + & Met_Data%TEMPG ( NCOLS,NROWS ), + & Met_Data%TSEASFC ( NCOLS,NROWS ), + & Met_Data%USTAR ( NCOLS,NROWS ), + & Met_Data%VEG ( NCOLS,NROWS ), + & Met_Data%LAI ( NCOLS,NROWS ), + & Met_Data%WR ( NCOLS,NROWS ), + & Met_Data%WSPD10 ( NCOLS,NROWS ), + & Met_Data%WSTAR ( NCOLS,NROWS ), + & Met_Data%Z0 ( NCOLS,NROWS ), + & Met_Data%SOIM1 ( NCOLS,NROWS ), + & Met_Data%SOIT1 ( NCOLS,NROWS ), + & Met_Data%SEAICE ( NCOLS,NROWS ), + & Met_Data%MOL ( NCOLS,NROWS ), + & Met_Data%MOLI ( NCOLS,NROWS ), + & Met_Data%HOL ( NCOLS,NROWS ), + & Met_Data%XPBL ( NCOLS,NROWS ), + & Met_Data%LPBL ( NCOLS,NROWS ), + & Met_Data%CONVCT ( NCOLS,NROWS ), + & Met_Data%PBL ( NCOLS,NROWS ), + & Met_Data%NACL_EMIS( NCOLS,NROWS ), + & Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ), + & Met_Data%PRES ( NCOLS,NROWS,NLAYS ), + & Met_Data%QV ( NCOLS,NROWS,NLAYS ), + & Met_Data%QC ( NCOLS,NROWS,NLAYS ), + & Met_Data%THETAV ( NCOLS,NROWS,NLAYS ), + & Met_Data%TA ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZH ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DENS ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACM ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACF ( NCOLS,NROWS,NLAYS ), + & Met_Data%RRHOJ ( NCOLS,NROWS,NLAYS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%DX3F ( NLAYS ), + & Grid_Data%RDX3F ( NLAYS ), + & Grid_Data%RDX3M ( NLAYS ), + & Grid_Data%RMSFX4 ( NCOLS,NROWS ), + & Grid_Data%LON ( NCOLS,NROWS ), + & Grid_Data%LAT ( NCOLS,NROWS ), + & Grid_Data%LWMASK ( NCOLS,NROWS ), + & Grid_Data%OCEAN ( NCOLS,NROWS ), + & Grid_Data%SZONE ( NCOLS,NROWS ), + & Grid_Data%PURB ( NCOLS,NROWS ), + & Grid_Data%SLTYP ( NCOLS,NROWS ), + & Grid_Data%NAME ( n_lufrac ), + & Grid_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%NAME = name_lu + Grid_Data%LU_Type = cat_lu + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + ALLOCATE( Met_Data%SOIM2 ( NCOLS,NROWS ), + & Met_Data%SOIT2 ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%WSAT ( NCOLS,NROWS ), + & Grid_Data%WWLT ( NCOLS,NROWS ), + & Grid_Data%BSLP ( NCOLS,NROWS ), + & Grid_Data%WRES ( NCOLS,NROWS ), + & Grid_Data%WFC ( NCOLS,NROWS ), + & Grid_Data%LUFRAC ( NCOLS,NROWS,n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%WSAT = 0.0 + Grid_Data%WWLT = 0.0 + Grid_Data%WFC = 0.0 + Grid_Data%WRES = 0.0 + Grid_Data%BSLP = 0.0 + + ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%VEG ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%Z0 ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RSTW ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RINC ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%NAME ( n_lufrac ), + & Mosaic_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Mosaic_Data%USTAR = 0.0 + Mosaic_Data%LAI = 0.0 + Mosaic_Data%DELTA = 0.0 + Mosaic_Data%VEG = 0.0 + Mosaic_Data%Z0 = 0.000001 + Mosaic_Data%RSTW = 0.0 + Mosaic_Data%RINC = 0.0 + Mosaic_Data%NAME = name_lu + Mosaic_Data%LU_Type = cat_lu + + ALLOCATE( ChemMos_Data%Rb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rst ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rcut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgc ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rwat ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%CZ0 ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cleaf ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cstom ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Ccut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Csoil ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%NAME ( n_lufrac ), + & ChemMos_Data%LU_Type ( n_lufrac ), + & ChemMos_Data%Subname ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating chemistry dependent mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + ChemMos_Data%Rb = resist_max + ChemMos_Data%Rst = resist_max + ChemMos_Data%Rcut = resist_max + ChemMos_Data%Rgc = resist_max + ChemMos_Data%Rgb = resist_max + ChemMos_Data%Rwat = resist_max + ChemMos_Data%CZ0 = 0.0 + ChemMos_Data%Cleaf = 0.0 + ChemMos_Data%Cstom = 0.0 + ChemMos_Data%Ccut = 0.0 + ChemMos_Data%Csoil = 0.0 + ChemMos_Data%NAME = name_lu + ChemMos_Data%LU_Type = cat_lu + ChemMos_Data%SubName = subname + End If + +!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + + If ( .Not. desc3( met_cro_2d ) ) Then + xmsg = 'Could not get ' // MET_CRO_2D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) rinv = .FALSE. ! Ra and Rst are in units s/m + + SPC = INDEX1( 'WR', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifwr = .True. ! canopy wetness is in METCRO2D + + SPC = INDEX1( 'Q2', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifq2 = .True. ! two meter mixing ratio in METCRO2D + + SPC = INDEX1( 'TSEASFC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifsst = .True. ! two meter SST in METCRO2D + + SPC = INDEX1( 'LH', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) iflh = .True. ! LH in METCRO2D + + SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rc = 'RCA' + Else + vname_rc = 'RC' + End If + + SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rn = 'RNA' + Else + vname_rn = 'RN' + End If + + If ( .Not. desc3( met_dot_3d ) ) Then + xmsg = 'Could not get ' // MET_DOT_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'UWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_uc = 'UWINDC' + CSTAGUV = .TRUE. + Else + vname_uc = 'UWIND' + CSTAGUV = .FALSE. + End If + + SPC = INDEX1( 'VWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_vc = 'VWINDC' + Else + vname_vc = 'VWIND' + End If + + If ( .Not. desc3( met_cro_3d ) ) Then + xmsg = 'Could not get ' // MET_CRO_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + V = INDEX1( 'PRES', NVARS3D, VNAME3D ) + If ( V .Ne. 0 ) Then + UNITSCK = UNITS3D( V ) + Else + XMSG = 'Could not get variable PRES from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Select Case (UNITSCK) + Case ( 'PASCAL','pascal','Pascal','PA','pa','Pa' ) + CONVPA = 1.0 + P0 = 100000.0 + Case ( 'MILLIBAR','millibar','Millibar','MB','mb','Mb' ) + CONVPA = 1.0E-02 + P0 = 100000.0 * CONVPA + Case ( 'CENTIBAR','centibar','Centibar','CB','cb','Cb' ) + CONVPA = 1.0E-03 + P0 = 100000.0 * CONVPA + Case Default + XMSG = 'Units incorrect on ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End Select + + MINKZ = .True. ! default + MINKZ = ENVYN( 'KZMIN', 'Kz min on flag', MINKZ, ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Write( LOGDEV,'(5X, A)' ) 'Kz min on flag' + Select Case( ALLOCSTAT ) + Case ( 1 ) + XMSG = 'Environment variable improperly formatted' + Call M3WARN( PNAME, JDATE, JTIME, XMSG ) + Case ( -1 ) + XMSG = 'Environment variable set, but empty ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + Case ( -2 ) + XMSG = 'Environment variable not set ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + End Select + + If ( .Not. MINKZ ) Then + XMSG = 'This run uses Kz0UT, *NOT* KZMIN in subroutine edyintb.' + Write( LOGDEV,'(/5X, A, /)' ) XMSG + End If + +!> Open the met files + + Call SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, + & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) + Call SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + Call SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + Call SUBHFILE ( MET_DOT_3D, GXOFF, GYOFF, + & STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ) + CALL SUBHFILE ( OCEAN_1, GXOFF, GYOFF, + & STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ) +!> Get sigma coordinate variables + X3M => BUFF1D + Do L = 1, NLAYS + Grid_Data%DX3F( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) + Grid_Data%RDX3F( L ) = 1.0 / Grid_Data%DX3F( L ) + X3M( L ) = 0.5 * ( X3FACE_GD( L ) + X3FACE_GD( L-1 ) ) + End Do + Do L = 1, NLAYS - 1 + Grid_Data%RDX3M( L ) = 1.0 / ( X3M( L+1 ) - X3M( L ) ) + End Do + Grid_Data%RDX3M( NLAYS ) = 0.0 +!> nullify pointer + Nullify( X3M ) + +!> reciprical of msfx2**2 +!> assign MSFX2 + MSFX2 => BUFF2D + VNAME = 'MSFX2' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, MSFX2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%RMSFX4 = 1.0 / ( MSFX2**2 ) +!> nullify pointer + Nullify( MSFX2 ) + + VNAME = 'LON' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LON ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LAT' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LWMASK' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LWMASK ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PURB' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%PURB ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + SOILCAT => BUFF2D + VNAME = 'SLTYP' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, SOILCAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%SLTYP = NINT( SOILCAT ) + Nullify( SOILCAT ) + + If ( ABFLUX .Or. MOSAIC ) Then + Do l = 1, n_lufrac + Write( vname,'( "LUFRAC_",I2.2 )' ) l + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LUFRAC( :,:,l ) ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End Do + + Forall( C = 1:MY_NCOLS, R = 1:MY_NROWS, Grid_Data%SLTYP(C,R) .Le. 11 ) + Grid_Data%WSAT( C,R ) = WSAT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WWLT( C,R ) = WWLT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WFC ( C,R ) = WFC ( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WRES( C,R ) = WRES( Grid_Data%SLTYP( C,R ) ) + Grid_Data%BSLP( C,R ) = BSLP( Grid_Data%SLTYP( C,R ) ) + End Forall + End If + +!> Read fractional seawater and surf-zone coverage from the OCEAN file. +!> Store results in the OCEAN and SZONE arrays. + IF ( .NOT. OPEN3( OCEAN_1, FSREAD3, PNAME ) ) THEN + XMSG = 'Open failure for ' // OCEAN_1 + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'OPEN' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%OCEAN ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SURF' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%SZONE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + MET_INITIALIZED = .true. + + Return + End Subroutine INIT_MET + +C======================================================================= + Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + Use UTILIO_DEFN +#ifdef parallel + USE SE_MODULES ! stenex (using SE_COMM_MODULE) +#else + USE NOOP_MODULES ! stenex (using NOOP_COMM_MODULE) +#endif + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_PE_COMM ! PE communication displacement and direction + Include SUBST_CONST ! constants + +C Arguments: + + Integer, Intent( IN ) :: JDATE, JTIME, TSTEP ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C Parameters: + Real, Parameter :: cond_min = 1.0 / resist_max ! minimum conductance [m/s] + Real, Parameter :: KZMAXL = 500.0 ! upper limit for min Kz [m] + Real, Parameter :: KZ0UT = 1.0 ! minimum eddy diffusivity [m**2/sec] KZ0 + Real, Parameter :: KZL = 0.01 ! lowest KZ + Real, Parameter :: KZU = 1.0 ! 2.0 ! highest KZ + Real, Parameter :: EPS = 1.0E-08 ! small number for temperature difference + +C Local variables: + Real FINT + Real CPAIR, LV, QST + Real TMPFX, TMPVTCON, TST, TSTV + Real, Pointer :: Es_Grnd ( :,: ) + Real, Pointer :: Es_Air ( :,: ) + Real, Pointer :: TV ( :,:,: ) + Integer LP + Integer C, R, L ! loop induction variables + + Character( 16 ) :: PNAME = 'GET_MET' + Character( 16 ) :: VNAME + CharactER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C----------------------------------------------------------------------- +C Interpolate file input variables and format for output +C-------------------------------- MET_CRO_3D -------------------------------- + + VNAME = 'ZH' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PRES' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%PRES ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'DENS' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%DENS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + Met_Data%DENS1 = Met_Data%DENS( :,:,1 ) + + VNAME = 'JACOBM' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACM ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACM = 1.0 / Met_Data%RJACM + + VNAME = 'JACOBF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACF = 1.0 / Met_Data%RJACF + + VNAME = 'DENSA_J' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RRHOJ ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RRHOJ = 1.0 / Met_Data%RRHOJ + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%TA ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QV ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QC' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QC ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C-------------------------------- MET_CRO_2D -------------------------------- +C Vegetation and surface vars + VNAME = 'LAI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LAI ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'VEG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%VEG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZRUF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Z0 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + +C Soil vars + VNAME = 'SOIM1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + VNAME = 'SOIM2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SOIT2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'SOIT1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SEAICE' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SEAICE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + +C met vars + + VNAME = 'PRSFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PRSFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RGRND' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RGRND ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SNOCOV' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SNOCOV ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Where( Met_Data%SNOCOV .Lt. 0.0 ) + Met_Data%SNOCOV = 0.0 + End Where + + VNAME = 'TEMP2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMP2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'TEMPG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMPG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'USTAR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%USTAR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'WSPD10' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WSPD10 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'HFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%HFX ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( iflh ) Then + VNAME = 'LH' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else ! for backward compatibility + VNAME = 'QFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'PBL' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PBL ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Met_cro_2D variables that have recently changed due to MCIP or WRF/CMAQ + + If ( .Not. INTERPX( MET_CRO_2D, vname_rn, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RN ) ) Then + XMSG = MSG1 // TRIM( vname_rn ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( .Not. INTERPX( MET_CRO_2D, vname_rc, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RC ) ) Then + XMSG = MSG1 // TRIM( vname_rc ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ifwr ) Then + VNAME = 'WR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + If ( ifsst ) Then + VNAME = 'TSEASFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TSEASFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%TSEASFC = Met_Data%TEMPG + End If + + If ( rinv ) Then + VNAME = 'RADYNI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RA .Gt. cond_min ) + Met_Data%RA = 1.0/Met_Data%RA + Elsewhere + Met_Data%RA = resist_max + End Where + + VNAME = 'RSTOMI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RS .Gt. cond_min ) + Met_Data%RS = 1.0 / Met_Data%RS + Elsewhere + Met_Data%RS = resist_max + End Where + + Else + + VNAME = 'RA' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RS' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + End If + + If ( ifq2 ) Then ! Q2 in METCRO2D + VNAME = 'Q2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Q2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%Q2 = Met_Data%QV( :,:,1 ) + End If + + Es_Grnd => BUFF2D + Where( Met_Data%TEMPG .Lt. stdtemp ) + Es_Grnd = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMPG ) ) + Elsewhere + Es_Grnd = vp0 *Exp( svp2 * ( Met_Data%TEMPG -stdtemp ) / ( Met_Data%TEMPG -svp3 ) ) + End Where + Met_Data%QSS_GRND = Es_Grnd * 0.622 / ( Met_Data%PRSFC - Es_Grnd ) + Nullify( Es_Grnd ) + + Es_Air => BUFF2D + Where( Met_Data%TEMP2 .Lt. stdtemp ) + Es_Air = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMP2 ) ) + Elsewhere + Es_Air = vp0 *Exp( svp2 * ( Met_Data%TEMP2 -stdtemp ) / ( Met_Data%TEMP2 -svp3 ) ) + End Where + Met_Data%RH = Met_Data%Q2 / ( Es_Air * 0.622 / ( Met_Data%PRSFC - Es_Air ) ) * 100.0 + Where( Met_Data%RH .Gt. 100.0 ) + Met_Data%RH = 100.0 + Elsewhere( Met_Data%RH .lt. 0.0 ) + Met_Data%RH = 0.0 + End Where + Nullify( Es_Air ) + +C-------------------------------- MET_DOT_3D -------------------------------- + If ( .Not. INTERPX( MET_DOT_3D, vname_uc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%UWIND ) ) Then + XMSG = MSG1 // TRIM( vname_uc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + If ( .Not. INTERPX( MET_DOT_3D, vname_vc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%VWIND ) ) Then + XMSG = MSG1 // TRIM( vname_vc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + +C get ghost values for wind fields in case of free trop. + CALL SUBST_COMM ( Met_Data%UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) + CALL SUBST_COMM ( Met_Data%VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) + +C-------------------------------- Calculated Variables -------------------------------- + Met_Data%DZF = Met_Data%ZF - EOSHIFT(Met_Data%ZF, Shift = -1, Boundary = 0.0, Dim = 3) + + Met_Data%RDEPVHT = 1.0 / Met_Data%ZF( :,:,1 ) + + IF ( MINKZ ) THEN + Met_Data%KZMIN = KZL + DO L = 1, NLAYS + Where( Met_Data%ZF( :,:,L ) .LE. KZMAXL ) + Met_Data%KZMIN( :,:,L ) = KZL + ( KZU - KZL ) * 0.01 * Grid_data%PURB + End Where + End Do + ELSE + Met_Data%KZMIN = KZ0UT + END IF + + TV => BUFF3D + TV = Met_Data%TA * ( 1.0 + 0.608 * Met_Data%QV ) + Met_Data%THETAV = TV * ( P0 / Met_Data%PRES ) ** 0.286 + Nullify( TV ) + +C------ Updating MOL, then WSTAR, MOLI, HOL + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + ! CPAIR = 1004.67 * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + CPAIR = CPD * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + TMPFX = Met_Data%HFX( C,R ) / ( CPAIR * Met_Data%DENS( C,R,1 ) ) + TMPVTCON = 1.0 + 0.608 * Met_Data%QV( C,R,1 ) ! Conversion factor for virtual temperature + TST = -TMPFX / Met_Data%USTAR( C,R ) + IF ( Met_Data%TA( C,R,1 ) .GT. STDTEMP ) THEN + LV = LV0 - ( 0.00237 * ( Met_Data%TA( C,R,1 ) - STDTEMP ) ) * 1.0E6 + ELSE + LV = 2.83E6 ! Latent heat of sublimation at 0C from Stull (1988) (J/KG) + END IF + QST = -( Met_Data%LH( C,R ) / LV ) + & / ( Met_Data%USTAR( C,R ) * Met_Data%DENS( C,R,1 ) ) + TSTV = TST * TMPVTCON + Met_Data%THETAV( C,R,1 ) * 0.608 * QST + IF ( ABS( TSTV ) .LT. 1.0E-6 ) THEN + TSTV = SIGN( 1.0E-6, TSTV ) + END IF + Met_Data%MOL( C,R ) = Met_Data%THETAV( C,R,1 ) + & * Met_Data%USTAR( C,R ) ** 2 / ( karman * GRAV * TSTV ) + IF ( Met_Data%MOL( C,R ) .LT. 0.0 ) THEN + Met_Data%WSTAR( C,R ) = Met_Data%USTAR( C,R ) * ( Met_Data%PBL( C,R ) + & / ( karman * ABS( Met_Data%MOL( C,R ) ) ) ) ** 0.333333 + ELSE + Met_Data%WSTAR( C,R ) = 0.0 + END IF + + END DO + END DO + + Met_Data%MOLI = 1.0 / Met_Data%MOL + Met_Data%HOL = Met_Data%PBL / Met_Data%MOL +C------ + + Met_Data%CONVCT = .FALSE. + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO L = 1, NLAYS + IF ( Met_Data%PBL( C,R ) .LT. Met_Data%ZF( C,R,L ) ) THEN + LP = L; EXIT + END IF + END DO + + Met_Data%LPBL( C,R ) = LP + If ( LP .Eq. 1 ) Then + FINT = ( Met_Data%PBL( C,R ) ) + & / ( Met_Data%ZF( C,R,LP ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + Else + FINT = ( Met_Data%PBL( C,R ) - Met_Data%ZF( C,R,LP-1 ) ) + & / ( Met_Data%ZF( C,R,LP ) - Met_Data%ZF( C,R,LP-1 ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + End If + END DO + END DO + Where( Met_Data%THETAV( :,:,1 ) - Met_Data%THETAV( :,:,2 ) .Gt. EPS .And. + & Met_Data%HOL .Lt. -0.02 .And. Met_Data%LPBL .Gt. 3 ) + Met_Data%CONVCT = .True. + End Where + + Return + End Subroutine GET_MET + + End Module ASX_DATA_MOD diff --git a/src/model/src/PHOT_MOD.F b/src/model/src/PHOT_MOD.F new file mode 100644 index 0000000..7d93dec --- /dev/null +++ b/src/model/src/PHOT_MOD.F @@ -0,0 +1,1898 @@ + +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + +C $Header$ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE PHOT_MOD + +C----------------------------------------------------------------------- +C +C FSB This version has NO internal write statements +C FSB This version has the code for XR96 added. +C FSB change indices from L to II in newOptics loop 08/17/2006 +C FSB This version has all write statements commented out.(08/03/2006) +C +C FSB NOTE - this code assumes that the top of the modeling domain +C is about 100 [mb] or 10 [kPa] ~ 16 [km] in altitude. If a +C higher altitude top is used , the method of calculating the +C ozone column and the ozone optical depth will be necessary. +C +C FSB This version has the addition of Rayleigh optical depth for the +C stratosphere as well as the calculation of single scattering +C albedo for the AOD calculation. (01/17/2006) +C FSB This version has deleted the JPROC values of Cs and Qy as well as +C the default aerosol. It also contains the fast optics +C routines. +C FSB This module supports the SAPRC99 Chemical mechanism within +C CMAQ. +C FSB This version calls a fast optical routine for aerosol +C extinction and scattering +C FSB This version uses a set of constant refractive indices +C The new subroutine GETNEWPAR now sets up the refractive indices. +C +C Bill Hutzell(Mar 2011) moved determining refractive indices to a +C separate file and new subroutine called AERO_PHOTDATA. +C +C Bill Hutzell(Jun 2011) modified TWOSTREAM_S subroutine to account for +C GAM2 equal to zero in the Toon et al. (1989) solution to the two stream +C of the radiative transfer equation based on how the NCAR TUV model +C implements the approximation +C +C Bill Hutzell(May 2013) modified optical depth agruments to give vetical +C profile rather than surface values. Note that TAU_TOT now includes +C stratospheric values. +! Bill Hutzell(Mar 2014) modified calculation of aerosol and cloud optical +! properites as well as their calculated optical depths. The changes employ +! FORTRAN modules that contain the layer level of the optical properties. +C 07 Jul 14 B.Hutzell: replaced mechanism include file(s) with fortran module +C 10/10/14 - DJL added references to IUPAC10 to NO2 and O3 photo rates +C 23Jun15 B.Hutzell: made TWOSTREAM and TRIDIAGONAL routine use REAL(8) variables +C 30Jul15 J.Young: REAL(4) -> REAL for code portability +C----------------------------------------------------------------------- + + USE CSQY_DATA + + IMPLICIT NONE + +!***include files + + INCLUDE SUBST_CONST ! physical constants + +!***parameters + + REAL, PARAMETER :: SMALL = 1.0E-36 ! a small number + +!***Fundamental Constants: ( Source: CRC76, pp 1-1 to 1-6) + + REAL, PARAMETER :: PLANCK_C = 6.62606876E-34 ! Planck's Constant [Js] + REAL, PARAMETER :: LIGHT_SPEED = 299792458.0 ! speed of light in a vacuum + + REAL, PARAMETER :: DU_TO_CONC = 2.6879E16 ! factor from [DU] to [molecules/cm^2] + REAL, PARAMETER :: CONC_TO_DU = 1.0 / DU_TO_CONC + + LOGICAL, PARAMETER :: ADJUST_OZONE = .FALSE. ! Flag to correct tropospheric ozone optical depth based + ! on climatology + + REAL :: MIN_STRATO3_FRAC ! minimum fraction of O3 column in statosphere + REAL :: MAX_TROPOO3_FRAC ! maximum fraction of O3 column in troposphere + +! REAL, PARAMETER :: MIN_STRATO3_FRAC = 0.55 ! minimum fraction of O3 column in statosphere + ! if PTOP = 50 mb +! REAL, PARAMETER :: MAX_TROPOO3_FRAC = 1.0 - MIN_STRATO3_FRAC ! maximum fraction of O3 column in troposphere + +!***LOGDEV for NEW_OPTICS and supporting routines + + INTEGER, SAVE :: NEW_OPTICS_LOG + + INTEGER, PARAMETER :: N_DIAG_WVL = 2 ! number of dianostic wavelengths + INTEGER, SAVE :: DIAG_WVL( N_DIAG_WVL ) ! pointers to diagnostic wavelengths + INTEGER :: N_TROPO_O3_TOGGLE ! number of adjustments to ozone extinction + + REAL, ALLOCATABLE :: ACTINIC_FLUX( :,: ) ! actinic fluxes, initially [Photons/(cm^2s)] then [Watts/m^2] + REAL, ALLOCATABLE :: IRRADIANCE ( :,: ) ! total downward irradiance [Watts/m^2] + REAL :: REFLECTION ! broad band reflection coefficient (diffuse) at model top + REAL :: TRANSMISSION ! broad band transmission coefficient (diffuse) at surface + REAL :: TRANS_DIRECT ! broad band direct transmission coefficient at surface + REAL :: TROPO_O3_COLUMN ! ozone column density in the troposphere [Dobson Units] + REAL :: TROPO_O3_TOGGLE ! factor correcting tropospheric ozone column + REAL :: O3_TOGGLE_AVE ! average of nonunity factors adjusting ozone extinction + REAL :: O3_TOGGLE_MIN ! Max of nonunity factors adjusting ozone extinction + + LOGICAL :: ONLY_SOLVE_RAD ! only compute fluxes + LOGICAL :: OBEY_STRATO3_MINS = .TRUE. ! Has stratospheric O3 column not violated + ! climatological minimums, yet? + LOGICAL :: STRATO3_MINS_MET ! Does the call to NEW_OPTICS meet the stratospheric O3 column + ! climatological minimums? + + + CHARACTER( 133 ) :: PHOT_MOD_MSG + + INTEGER :: PHOT_COL ! cell column of routine calling module routine + INTEGER :: PHOT_ROW ! cell row of routine calling module routine + + + CONTAINS + +C/////////////////////////////////////////////////////////////////////// + SUBROUTINE NEW_OPTICS ( JDATE, JTIME, NLAYS, + & BLKTA, BLKPRS, BLKDENS, BLKZH, BLKZF, + & BLKO3, BLKNO2, + & ZSFC, COSZEN, SINZEN, RSQD, + & NEW_PROFILE, CLOUDS, CLDFRC, + & BLKRJ, TAUC_AERO, TAU_TOT, TAUO3_TOP, + & TAU_RAY, SSA_AERO, TAU_CLOUD, TOTAL_O3_COLUMN ) +C----------------------------------------------------------------------- +C +C FSB NOTE new call vector <<<<<<<<<<<<< ********** +C +C FSB This version has clouds +C FSB calculates the photolysis rates as a function of species and height +C +C first coded 10/19/2004 by Dr. Francis S. Binkowski +C Carolina Environmental Program +C University of North Carolina at Chapel Hill +C email: frank_binkowski@unc.edu +C modified by FSB July 29, 2005, 01/19/2006 by FSB +C +C Mar 2011 Bill Hutzell +C -revised arguement to account for aerosol redesign in +C CMAQ version 5.0 +C -change array declaration to allow flexible number of +C wavelength bins +C Apr 2012 Bill Hutzell +C -revised error checking to needed photolysis data +C -modified case statement for RACM2 photolysis rates +C -moved aerosol optics to its own module +C 07 Jul 14 B.Hutzell: replaced mechanism include file(s) with fortran module +C----------------------------------------------------------------------- + + USE UTILIO_DEFN + USE RXNS_DATA ! chemical mechanism data + USE CLOUD_OPTICS ! data and routines for optics of cloud hydrometeors + + USE AERO_PHOTDATA + + IMPLICIT NONE + +!***arguments + INTEGER, INTENT(IN) :: JDATE ! julian date YYYYDDD + INTEGER, INTENT(IN) :: JTIME ! TIME HHMMSS + INTEGER, INTENT(IN) :: NLAYS ! # of vertical layers + + REAL, INTENT(IN) :: BLKPRS ( : ) ! Air pressure in [ atm ] + REAL, INTENT(IN) :: BLKTA ( : ) ! Air temperature [ K ] + REAL, INTENT(IN) :: BLKDENS( : ) ! Air density [ molecules / cm**3 ] + REAL, INTENT(IN) :: BLKZH ( : ) ! layer half-height [ m ] + REAL, INTENT(IN) :: BLKZF ( : ) ! layer full height[ m ] + REAL, INTENT(IN) :: BLKO3 ( : ) ! O3 concentration [ molecules / cm**3 ] + REAL, INTENT(IN) :: BLKNO2 ( : ) ! NO2 concentration [ molecules / cm**3 ] + REAL, INTENT(IN) :: ZSFC ! surface height (msl) [ m ] + REAL, INTENT(IN) :: COSZEN, SINZEN ! sine and cosine of the zenith angle + REAL, INTENT(IN) :: RSQD ! square of solar distance [ au**2 ] + + LOGICAL, INTENT(IN) :: NEW_PROFILE ! Has the atmospheric profile changed since last call? + LOGICAL, INTENT(IN) :: CLOUDS( : ) ! Does layer have clouds + REAL, INTENT(IN) :: CLDFRC( : ) ! fraction of gridcell covered by cloud + + + REAL, INTENT(OUT) :: BLKRJ( :,: ) ! photolysis rates [ 1 / sec ] + + REAL, INTENT(OUT) :: TAUC_AERO( :,: ) ! aerosol optical depth, bottom of layer + REAL, INTENT(OUT) :: TAU_TOT ( :,: ) ! total optical depth, bottom of layer + REAL, INTENT(OUT) :: TAU_CLOUD( :,: ) ! cloud optical depth, bottom of layer + + REAL, INTENT(INOUT) :: TAUO3_TOP( : ) ! optical depth of ozone above model domain + REAL, INTENT(INOUT) :: TAU_RAY ( : ) ! Rayleigh optical depth above model domain + REAL, INTENT(OUT) :: SSA_AERO ( : ) ! single scatering albedo for aerosol column + + REAL, INTENT(INOUT) :: TOTAL_O3_COLUMN ! total ozone colum density [ DU ] + +!***internal + REAL, PARAMETER :: ONE_OVER_PI = 1.0 / PI + REAL, PARAMETER :: STRAT_TEMP = 225.0 ! stratospheric temperature + REAL, PARAMETER :: ZTOA = 50.0E3 ! top of the atmosphere [ m ] + + INTEGER L, I, IWL, II, ILEV, IPHOT, MODE ! loop indices + + INTEGER NLEVEL + REAL SOLAR_FLUX ! solar flux at atmosphere top in a wavelength band, [photons/(cm^2*s)] + REAL INSOLATION ! downward solar flux at atmosphere top summed over wavelength bands, [photons/(cm^2*s)] + + REAL DELTA_O3_COLUMN ! change in ozone column density [molecules/cm2] + REAL STRAT_O3_COLUMN ! ozone column density in the stratosphere [molecules/cm2] + REAL STRAT_O3_COLMIN ! ozone minium column density in the stratosphere [molecules/cm2] + REAL TAU_O3 ! optical depth of stratospheric ozone [ m ] + REAL DENSTOM ! estimated air density at top of model [ molecules / cm**3 ] + REAL LAMDA ! wavelength [ nm ] + REAL INV_LAMBDA ! reciprocal of wavelength [ 1/nm ] + REAL LAMDA_UM ! wavelength [ um ] + +!***working absorption cross sections [ cm**2 ]. These have been corrected +!*** for ambient ( pressure and temperature ) conditions. + + REAL AO3 + REAL ANO2 + REAL BETA_M ! molecular scattering coefficient [ 1/m ] + REAL BEXT ! total aerosol extinction coefficient [ 1/m ] + REAL VFAC, BSC ! unit correction factors + REAL BSCAT ! total aerosol scattering coefficient [ 1/m ] + REAL G_BAR ! total aerosol asymmetry factor + +!***FSB The following variable is aq switch that allows a fast version of +!*** aerosol optics to be used when set to .TRUE. + +!***scattering and absorption for the layer + + REAL DTABS_A, DTABS_M, DTSCAT_A, DTSCAT_M, DTSCAT, DTABS + +!***variables describing the layer heights and slants +! REAL DJ, DF + REAL ZTOM ! top of model [ m ] + REAL, ALLOCATABLE, SAVE :: DSDH_TD( : ) ! slant path function from top down + REAL, ALLOCATABLE, SAVE :: BLKDZ( : ) ! layer thicknesses [ m ] + REAL, ALLOCATABLE, SAVE :: DSDH( : ) ! slant path function + REAL, SAVE :: DSDH_TOP ! slantpath function from ZTOM to ZTOA + +!***Increment of optical depth + + REAL, ALLOCATABLE, SAVE :: DTAU ( : ) ! total depth at level + REAL, ALLOCATABLE, SAVE :: DT_AERO ( : ) ! aerosol contribution at level + REAL, ALLOCATABLE, SAVE :: DT_CLOUD( : ) ! cloud contribution at level + +!***single scattering albedo for layer + + REAL, ALLOCATABLE, SAVE :: OM( : ) + +!***asymmetry factor + + REAL, ALLOCATABLE, SAVE :: G( : ) + +!***arrays for fluxes and irradiances used in + +!***delta-Eddington code + + REAL, ALLOCATABLE, SAVE :: FDIR( : ) ! direct actinic flux + REAL, ALLOCATABLE, SAVE :: FUP ( : ) ! diffuse upward actinic flux + REAL, ALLOCATABLE, SAVE :: FDN ( : ) ! diffuse downward flux + REAL, ALLOCATABLE, SAVE :: EDIR( : ) ! direct irradiance + REAL, ALLOCATABLE, SAVE :: EUP ( : ) ! diffuse upward irradiance + REAL, ALLOCATABLE, SAVE :: EDN ( : ) ! diffuse downward irradiance + +!***surface albedo + + REAL RSFC + + REAL FX + REAL, ALLOCATABLE, SAVE :: ESUM( : ) ! total downward irradiance + REAL, ALLOCATABLE, SAVE :: FSUM( : ) ! total actinic flux + +!***needed for stratospheric Raleigh optical depth + REAL, PARAMETER :: R_G = 100.0 * RDGAS / GRAV ! dry air gas constant + ! divided by gravitational + ! acceleration [cm/K] NOTE: cgs units + + REAL HSCALE ! Scale height [cm] ! NOTE: cgs units + + REAL NBAR ! total number of air molecules [ # /cm**2 ] + ! above top of model domain + + REAL, SAVE :: COS85 + +!***FSB Cloud properties. +!*** FSB These properties are taken fro HU & Stamnes,1993, +!*** An accurate parameterizationof the radiative properties of +!*** water clouds suitable for use in climate models, Journal of +!*** Climate, vol. 6, pp. 728-742. The values in the data statements +!*** were calculated with an equivalent radius of 10 micrometers. +!*** Note: Hu &Stamnes give beta in [ 1 / km/ for LWC in [ g / m**3 ] +!*** the values for beta/ LWC also give beta in [1/m] with LWC in [g/m **3] + + REAL G_CLOUD ! local cloud asymmetry factor + REAL OM_CLOUD ! local cloud single scattering albedo + REAL DTSCAT_CLOUD ! level increment in cloud scattering optical + REAL TAU_SCAT_CLD ! total scattering optical depth of cloud + REAL LAYERING_FACTOR ! correction factor for cloud layering + REAL STOZONE + + LOGICAL, SAVE :: FIRST = .TRUE. ! Flag for first call + LOGICAL :: SUCCESS + +!***arrays for fluxes and irradiances used in + REAL, ALLOCATABLE, SAVE :: SRAYL( : ) ! Molecular scattering cross sections [ cm ** 2] + REAL, ALLOCATABLE, SAVE :: TAU_SCAT( : ) ! aerosol scattering optical depth + REAL, ALLOCATABLE, SAVE :: CONV_WM2( : ) ! conversion factor [photons/(cm**2 s )] to [Watts/m**2] + +!***three-dimensional array for Cs and Qy +!*** (temperature, wavelength, species) +!***(layer, wavelength species) + + REAL, ALLOCATABLE, SAVE :: CSZ( :,:,: ) + REAL, ALLOCATABLE, SAVE :: QYZ( :,:,: ) + + IF ( FIRST ) THEN + + NEW_OPTICS_LOG = INIT3() + + ALLOCATE( CONV_WM2( NWL ) ) + ALLOCATE( SRAYL ( NWL ) ) + ALLOCATE( TAU_SCAT( NWL ) ) + ALLOCATE( CSZ( NLAYS,NWL,NPHOTAB ) ) + ALLOCATE( QYZ( NLAYS,NWL,NPHOTAB ) ) + + ALLOCATE( ACTINIC_FLUX( NLAYS,NWL ) ) + ALLOCATE( IRRADIANCE ( NLAYS,NWL ) ) + + ALLOCATE( DSDH_TD ( NLAYS+1 ), + & BLKDZ ( NLAYS ), + & DSDH ( NLAYS ), + & DTAU ( NLAYS+1 ), + & DT_AERO ( NLAYS+1 ), + & DT_CLOUD( NLAYS+1 ), + & OM ( NLAYS+1 ), + & G ( NLAYS+1 ), + & FDIR ( NLAYS+1 ), + & FUP ( NLAYS+1 ), + & FDN ( NLAYS+1 ), + & EDIR ( NLAYS+1 ), + & EUP ( NLAYS+1 ), + & EDN ( NLAYS+1 ), + & ESUM ( NLAYS ), + & FSUM ( NLAYS ) ) + +!***FSB Set up conversion factor for +!*** [photons / ( cm**2 s) ] to [Watts / m**2 ] +!*** THE 1.0E13 FACTO IS 1.0E9 * 1.0 E4 +!*** The 1.0e9 is for the wavelength [ nm ] -> [ m ] +!*** The 1.0e4 is for the area [ cm **2 ] -> [ m**2 ] + + DO IWL = 1, NWL + LAMDA = WAVELENGTH( IWL ) + CONV_WM2( IWL ) = 1.0E13 * ( PLANCK_C * LIGHT_SPEED ) / LAMDA + END DO + + COS85 = COS( 85.0 * PI180 ) + +!***get molecular scattering cross sections + + CALL GETSRAY ( NWL, WAVELENGTH, SRAYL ) + + FIRST = .FALSE. + + END IF ! FIRSTIME + +!***initialize BLKRJ and other layer variables + + BLKRJ = 0.0 + ACTINIC_FLUX = 0.0 + IRRADIANCE = 0.0 + REFLECTION = 0.0 + TRANSMISSION = 0.0 + TRANS_DIRECT = 0.0 + INSOLATION = 0.0 + TROPO_O3_TOGGLE = 1.0 + STRATO3_MINS_MET = .TRUE. +!***Initialize sums or set default values for outputs: +! TAUC_AERO, TAU_TOT, TAUO3_TOP, TAU_RAY, SSA_AERO, etc. + + TAUC_AERO = 0.0 + TAU_TOT = 0.0 + TAU_CLOUD = 0.0 + TAU_SCAT = 0.0 + SSA_AERO = 0.0 + TOTAL_TAU_CLD = 0.0 +#ifdef phot_debug + AVE_SSA_CLD = 0.0 + AVE_ASYMM_CLD = 0.0 +#endif +!***Test zenith angle. If coszen is zero or negative, zenith angle is +!*** equal to or greater than 90 degrees, i.e. before sunrise or +!*** after sunset at the surface. +!*** Return all photolysis rates set to zero. Ignore possible twilight +!*** processes in upper troposphere. + +!***FSB NOTE: tests of the algorithm for slant path show that the +!*** critical zenith angle for the tropospheric slant path is 88 degrees, +!*** but the critical zenith angle for the stratospheric slant path is +!*** 85 degrees. Thus, the code returns zeros for angles greater then or +!*** equalt to 85 degrees. cos( 85 degrees ) equals 8.715574e-02. + + IF ( COSZEN .LE. COS85 ) THEN + TAUO3_TOP = 0.0 + TAU_RAY = 0.0 + TOTAL_O3_COLUMN = 0.0 + TROPO_O3_COLUMN = 0.0 + TROPO_O3_TOGGLE = 1.0 + RETURN + END IF + + IF ( NEW_PROFILE ) THEN ! update based on new temperature and density profile +!***Adjust cross sections and quantum yields for ambient conditions + + CALL GET_CSQY ( BLKTA, BLKDENS, CSZ, QYZ ) + +!***calculate scale height from top of model domain + + HSCALE = R_G * BLKTA( NLAYS ) + +!***estimate air density at top of model domain + + DENSTOM = BLKDENS( NLAYS ) + & * EXP( -100.0 * ( BLKZF( NLAYS + 1 ) - BLKZH( NLAYS ) ) + & / HSCALE ) + +!***calculate the total number of air molecules [ # / cm**2 ] +!*** above top of model domain. + + NBAR = HSCALE * DENSTOM + +!***set top of modeling domain + + ZTOM = BLKZF( NLAYS + 1 ) + +!***get layer thicknesses and slantpath starting at the TOP + + CALL SLANTPATH2 ( NLAYS, BLKZF, ZSFC, REARTH, SINZEN, BLKDZ, DSDH ) + +!***get slantpath from ZTOM to ZTOA + + CALL SLANTPATHTOP ( ZTOM, ZTOA, ZSFC, REARTH, SINZEN, DSDH_TOP ) + +C*** find ozone column density for atmosphere, stratosphere, and troposphere + STRAT_O3_COLUMN = DU_TO_CONC * REAL( TOTAL_O3_COLUMN ) +! STRAT_O3_COLMIN = 0.10 * STRAT_O3_COLUMN + STRAT_O3_COLMIN = MIN_STRATO3_FRAC * STRAT_O3_COLUMN + SUCCESS = .TRUE. + TROPO_O3_COLUMN = 0.0 + DO L = NLAYS, 1, -1 + DELTA_O3_COLUMN = 100.0 * BLKO3( L ) * BLKDZ( L ) + STRAT_O3_COLUMN = STRAT_O3_COLUMN - DELTA_O3_COLUMN + TROPO_O3_COLUMN = TROPO_O3_COLUMN + DELTA_O3_COLUMN + IF ( STRAT_O3_COLUMN .LT. STRAT_O3_COLMIN .AND. SUCCESS ) THEN + IF( OBEY_STRATO3_MINS )THEN + WRITE( NEW_OPTICS_LOG,'( /A, F5.2, A, 3(/A), I3, A, F8.3, A , 2(I4,1X) )' ) + & 'PHOT WARNING: First Occurance where computed stratospheric O3 column < ', + & 100.0*MIN_STRATO3_FRAC,'%', + & 'observed total column. The percentage is a global minimum based on ', + & 'climatological ozone profiles. ', + & 'The Error accumulates downward from layer = ', L, ' or alt= ', + & 0.001*BLKZF( L ),' Km for col,row = ', PHOT_COL, PHOT_ROW + END IF + SUCCESS = .FALSE. + END IF + END DO + + STRAT_O3_COLUMN = CONC_TO_DU * STRAT_O3_COLUMN + TROPO_O3_COLUMN = CONC_TO_DU * TROPO_O3_COLUMN + +#ifdef verbose_PHOT_MOD + IF( PHOT_COL .EQ. 1 .AND. PHOT_ROW .EQ. 1 )THEN + WRITE( NEW_OPTICS_LOG,*)'TOTAL_O3_COLUMN, TROPO_O3_COLUMN = ',TOTAL_O3_COLUMN, TROPO_O3_COLUMN + END IF +#endif + + IF ( .NOT. SUCCESS ) THEN + TROPO_O3_TOGGLE = MAX_TROPOO3_FRAC * TOTAL_O3_COLUMN + & / TROPO_O3_COLUMN + N_TROPO_O3_TOGGLE = N_TROPO_O3_TOGGLE + 1 + O3_TOGGLE_AVE = O3_TOGGLE_AVE + TROPO_O3_TOGGLE + O3_TOGGLE_MIN = MIN( O3_TOGGLE_MIN, TROPO_O3_TOGGLE) + STRATO3_MINS_MET = .FALSE. + STRAT_O3_COLUMN = CONC_TO_DU * STRAT_O3_COLMIN + IF( OBEY_STRATO3_MINS )THEN ! write to PE log for first occurance + WRITE( NEW_OPTICS_LOG, 99983)STRAT_O3_COLUMN + IF( ADJUST_OZONE ) WRITE( NEW_OPTICS_LOG, 99984)TROPO_O3_TOGGLE + WRITE( NEW_OPTICS_LOG, 99887) + WRITE( NEW_OPTICS_LOG, 99888)TOTAL_O3_COLUMN, TROPO_O3_COLUMN, MAX_TROPOO3_FRAC + WRITE( NEW_OPTICS_LOG, 99999) + OBEY_STRATO3_MINS = .FALSE. + END IF + IF( .NOT. ADJUST_OZONE ) TROPO_O3_TOGGLE = 1.0 ! reset toggle to one + ELSE + TROPO_O3_TOGGLE = 1.0 + END IF + + +99983 FORMAT( 'Corrective Action: 1) Stratospheric O3 column set to ',F8.3,' DU' ) +99984 FORMAT( 'and 2) Extinction from Model Domain O3 multiplied by ',F9.6 ) +99887 FORMAT(/'Check TROPO_O3_EXCEED and N_EXCEED_TROPO3 in PHOTDIAG1 file for ' + & /'values greater than zero to assess the extent of the ' + & /'problem. TROPO_O3_EXCEED and N_EXCEED_TROPO3 are the average ' + & /'exceedance and their number over file time step for each grid cell,' + & /'respectively. Exceedance depends on the predicted tropospheric' + & /'fraction over the maximum allowed fraction of the total ozone column.' + & /'Its value equals the ratio minus one if ratio is greater than one and' + & /'zero if the ratio is less than or equal to one. N_EXCEED_TROPO3 ' + & /'counts the number of nonzero values per timestep') +99888 FORMAT(/'Direct Cause: Predicted O3 tropospheric Column exceeds maximum allowed ' + & /'fraction of total OMI column.', + & /'OMI Total O3 Column = ',F8.3,' DU: Model Tropospheric O3 Column = ',F8.3,' DU', + & /'Climatological Expected Tropospheric Fraction = ',F9.6) +99999 FORMAT(/'ULTIMATE causes include boundary condition and meteorological input files. ' + & /'Check the former for unrealistic concentrations of ozone and its precursors.' + & /'Check the latter for unrealistic advection and diffusion parameters.') + + DO IWL = 1, NWL +!***Get optical depth for stratospheric ozone column +!***Note that stratosphere ozone coluumn assumed to exist above model domain + CALL GET_TAUO3 ( IWL, STRAT_O3_COLUMN, STRAT_TEMP, TAUO3_TOP( IWL ) ) +!***get Rayleigh optical depth for stratosphere + TAU_RAY( IWL ) = NBAR * SRAYL( IWL ) + END DO + END IF ! for NEW_PROFILE + +!***loop over wavelengths + DO IWL = 1, NWL ! outermost loop + +! RSFC = ALB( IWL ) ! surface albedo + +!***set scaling factor for reducing extraterrestrial flux +!*** add ozone and Rayleigh optical depths. Use the +!*** pseudospherical correction for the stratosphere. + + SOLAR_FLUX = FEXT( IWL ) / RSQD + +!*** initialize tau, delta tau's, other variables and loop over layers + + DTAU = 0.0 + DT_AERO = 0.0 + DT_CLOUD = 0.0 + DTSCAT_CLOUD = 0.0 + TAU_SCAT_CLD = 0.0 + + DO L = 2, NLAYS + 1 + II = NLAYS + 2 - L ! from top to bottom + +!***in the following statements the factor of 100.0 converts +!*** converts [ 1 / cm ] to [ 1 / m ] + + BETA_M = SRAYL( IWL ) * BLKDENS( II ) * 100.0 + AO3 = CSZ( II,IWL,LO3O3P ) * BLKO3 ( II ) * 100.0 + AO3 = TROPO_O3_TOGGLE * AO3 + ANO2 = CSZ( II,IWL,LNO2 ) * BLKNO2 ( II ) * 100.0 + +!***set up aerosol optical properties + + G_BAR = AERO_ASYM_FAC ( II,IWL ) + BEXT = AERO_EXTI_COEF( II,IWL ) + BSCAT = AERO_SCAT_COEF( II,IWL ) + +!***calculate total absorption and scattering contributions +!***to optical depth + +!***The contributions to scattering and absorption from molecules and particles +!*** are calculated separately to facilitate the calculation +!*** of the total single scatering albedo of the column of aerosols +!*** as measured by satellites. + + DTSCAT_M = BETA_M * BLKDZ( II ) ! molecular scattering + DTSCAT_A = BSCAT * BLKDZ( II ) ! particle scattering + + DTSCAT_M = MAX( DTSCAT_M, SMALL ) + DTSCAT_A = MAX( DTSCAT_A, SMALL ) + + + DTABS_M = ( AO3 + ANO2 ) * BLKDZ( II ) ! molecular absorption + DTABS_A = ( BEXT - BSCAT ) * BLKDZ( II ) ! particle absorption + + DTABS_M = MAX( DTABS_M, SMALL ) + DTABS_A = MAX( DTABS_A, SMALL ) + + IF ( CLOUDS( II ) ) THEN + + DT_CLOUD( L ) = ( CLOUD_LIQUID_EXT( II,IWL ) + & + CLOUD_ICE_EXT( II,IWL ) + & + CLOUD_AGGREG_EXT( II,IWL ) ) * BLKDZ( II ) + DTSCAT_CLOUD = ( CLOUD_LIQUID_SCAT( II,IWL ) + & + CLOUD_ICE_SCAT( II,IWL ) + & + CLOUD_AGGREG_SCAT( II,IWL ) ) * BLKDZ( II ) + +!Adjust DT_CLOUD for cloud fraction by 1/2 power of CLDFRC to approximate cloud overlap. +!Note that the power results because the resolved cloud conentrations are averaged over +!the grid cell so the net overlap correction equal cfrac**(3/2) from Briegleb (1992) times +!cfrac**(-1) for actual in-cloud concentrations (see Voulgarakis et al., 2009, Geosci Model +!Dev., vol. 2, pp. 59-72. + + IF ( CLOUD_LAYERING( II ) ) THEN + LAYERING_FACTOR = SQRT( CLDFRC( II ) ) + ELSE + LAYERING_FACTOR = CLDFRC( II ) + END IF + DT_CLOUD( L ) = DT_CLOUD( L ) * LAYERING_FACTOR + DTSCAT_CLOUD = DTSCAT_CLOUD * LAYERING_FACTOR + + TAU_SCAT_CLD = TAU_SCAT_CLD + DTSCAT_CLOUD + + IF ( DT_CLOUD( L ) .GT. 1.0E-6 ) THEN + OM_CLOUD = MAX( DTSCAT_CLOUD /DT_CLOUD( L ), 1.0) + IF ( OM_CLOUD .LT. 0.0 .OR. OM_CLOUD .GT. 1.0 .OR. OM_CLOUD .NE. OM_CLOUD) THEN + WRITE( NEW_OPTICS_LOG,'(A,I3,A,ES12.4,A)',ADVANCE = 'NO') + & 'OM_CLOUD( L = ', L, ' ) = ', OM_CLOUD,' resetting to ' + OM_CLOUD = MAX( 0.000001, MIN( OM_CLOUD, 0.99999)) + WRITE( NEW_OPTICS_LOG,'(ES12.4)')OM_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'LIQUID_EXT, LIQUID_SCAT = ', + & CLOUD_LIQUID_EXT( II,IWL ), CLOUD_LIQUID_SCAT( II,IWL ) + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'ICE_EXT, ICE_SCAT = ', + & CLOUD_ICE_EXT( II,IWL ), CLOUD_ICE_SCAT( II,IWL ) + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'AGGREG_EXT, AGGREG_SCAT = ', + & CLOUD_AGGREG_EXT( II,IWL ), CLOUD_AGGREG_SCAT( II,IWL ) + CALL M3EXIT( 'NEW_OPTICS', JDATE, JTIME, ' ', XSTAT1 ) + END IF + ELSE + OM_CLOUD = 1.0 + END IF + + IF ( DTSCAT_CLOUD .GT. 1.0E-6 ) THEN + + G_CLOUD = ( (CLOUD_LIQUID_ASY( II,IWL ) * CLOUD_LIQUID_SCAT( II,IWL )) + & + (CLOUD_ICE_ASY( II,IWL ) * CLOUD_ICE_SCAT( II,IWL )) + & + (CLOUD_AGGREG_ASY( II,IWL ) * CLOUD_AGGREG_SCAT( II,IWL )) ) + & * BLKDZ( II ) * LAYERING_FACTOR + +#ifdef phot_debug + IF ( .NOT. ONLY_SOLVE_RAD ) THEN + AVE_ASYMM_CLD( IWL ) = AVE_ASYMM_CLD( IWL ) + G_CLOUD + IF ( AVE_ASYMM_CLD( IWL ) .GT. TAU_SCAT_CLD ) THEN + WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) + & 'Sum for AVE_ASYMM_CLD at L (', L,') = ', AVE_ASYMM_CLD( IWL ), + & ' Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'AVE_ASYMM_CLD Increment = ', G_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'TAU_SCAT_CLD Increment = ', DTSCAT_CLOUD + END IF + END IF +#endif + + G_CLOUD = G_CLOUD / DTSCAT_CLOUD + + IF ( G_CLOUD .GE. 1.0 .OR. G_CLOUD .LE. -1.0 .OR. G_CLOUD .NE. G_CLOUD ) THEN + WRITE( NEW_OPTICS_LOG,'(A,I3,A,ES12.4,A)',ADVANCE = 'NO' ) + & 'G_CLOUD( L = ', L, ' ) = ', G_CLOUD,' resetting to ' + G_CLOUD = MIN( 0.9999, MAX( G_CLOUD, -0.9999) ) + WRITE( NEW_OPTICS_LOG,'(ES12.4)') G_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'LIQUID_ASY, LIQUID_SCAT = ', + & CLOUD_LIQUID_ASY( II,IWL ), CLOUD_LIQUID_SCAT( II,IWL ) + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'ICE_ASY, ICE_SCAT = ', + & CLOUD_ICE_ASY( II,IWL ), CLOUD_ICE_SCAT( II,IWL ) + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'AGGREG_ASY, AGGREG_SCAT = ', + & CLOUD_AGGREG_ASY( II,IWL ), CLOUD_AGGREG_SCAT( II,IWL ) + CALL M3EXIT( 'NEW_OPTICS', JDATE, JTIME, ' ', XSTAT1 ) + END IF + ELSE + G_CLOUD = 0.0 + END IF + ELSE + DTSCAT_CLOUD = 0.0 + G_CLOUD = 0.0 + OM_CLOUD = 1.0 + END IF + +!***calculate total absorption and scattering contributions +!***to optical depth + + DTSCAT = DTSCAT_M + DTSCAT_A + DTSCAT_CLOUD + DTABS = DTABS_M + DTABS_A + MAX(( 1.0 - OM_CLOUD ), 0.0) * DT_CLOUD( L ) + +!***set aerosol optical depth for later use + + DT_AERO ( L ) = BEXT * BLKDZ( II ) + +!***Now calculate the vertical profiles of optical depth, +!*** single scattering albedo, asymmetry factor +!*** and DSDH starting at the top. + + DTAU( L ) = DTSCAT + DTABS + OM ( L ) = DTSCAT / ( DTSCAT + DTABS ) + G ( L ) = ( G_BAR * DTSCAT_A + G_CLOUD * DTSCAT_CLOUD ) / DTSCAT + + IF ( G( L ) .GE. 1.0 .OR. G( L ) .LE. -1.0 .OR. G( L ) .NE. G( L ) ) THEN + WRITE( NEW_OPTICS_LOG,'(A,ES12.4,A)',ADVANCE = 'NO' ) + & 'G( L ) = ', G( L ),' resetting to ' + G( L ) = MIN( 0.9999, MAX( G( L ), -0.9999) ) + WRITE( NEW_OPTICS_LOG,'(ES12.4)')G( L ) + WRITE( NEW_OPTICS_LOG,'(A,10(1X,ES12.4))' ) + & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD, G_BAR, G_CLOUD = ', + & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD, G_BAR, G_CLOUD + END IF + + IF ( OM( L ) .GT. 1.0 .OR. OM( L ) .LE. 0.0 .OR. OM( L ) .NE. OM( L ) ) THEN + WRITE( NEW_OPTICS_LOG,'(A,ES12.4,A)',ADVANCE = 'NO' ) + & 'OM( L ) = ', OM( L ),' resetting to ' + OM( L ) = MIN( 0.9999, MAX( OM( L ), 0.0001) ) +#ifdef phot_debug + WRITE( NEW_OPTICS_LOG,'(ES12.4)' ) OM( L ) + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DTSCAT, DTABS, ( DTSCAT + DTABS) = ', + & DTSCAT, DTABS, ( DTSCAT + DTABS ) + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD = ', + & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DDTABS_M, DTABS_A, MAX(( 1.0-OM_CLOUD ), 0.0) * DT_CLOUD( L ) = ', + & DTABS_M, DTABS_A, MAX(( 1.0 - OM_CLOUD ), 0.0) * DT_CLOUD( L ) + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & ' AO3, ANO2,AERO_BEXT, AERO_BSCAT = ', + & AO3, ANO2,BEXT, BSCAT +#endif + ELSE +#ifdef phot_debug + IF ( OM( L ) .EQ. 1.0 ) THEN + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DTSCAT, DTABS, ( DTSCAT + DTABS ) = ', + & DTSCAT, DTABS, (DTSCAT + DTABS) + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD = ', + & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'DDTABS_M, DTABS_A, MAX(( 1.0-OM_CLOUD ), 0.0) * DT_CLOUD( L ) = ', + & DTABS_M, DTABS_A, MAX(( 1.0 - OM_CLOUD ), 0.0 ) * DT_CLOUD( L) + WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) + & 'AO3, ANO2,AERO_BEXT, AERO_BSCAT = ', + & AO3, ANO2,BEXT, BSCAT + END IF +#endif + OM( L ) = MIN( 0.9999, OM( L ) ) + END IF + + DSDH_TD( L ) = DSDH( L - 1 ) + + IF ( ONLY_SOLVE_RAD ) CYCLE +!***FSB get sums of unscaled optical depths + + TAU_SCAT( IWL ) = TAU_SCAT ( IWL ) + DTSCAT_A + +!***initialize optical depth profiles to the layer increment + + TAUC_AERO( II,IWL ) = DT_AERO( L ) ! aerosol optical depth + TAU_TOT ( II,IWL ) = DTAU( L ) ! total optical depth + TAU_CLOUD( II,IWL ) = DT_CLOUD( L ) ! cloud optical depth + + END DO ! loop over layers + +!***set values for the stratosphere + + OM ( 1 ) = TAU_RAY( IWL ) / ( TAU_RAY( IWL ) + TAUO3_TOP( IWL ) ) + G ( 1 ) = 0.05 + DTAU ( 1 ) = TAUO3_TOP( IWL ) + TAU_RAY( IWL ) + DSDH_TD( 1 ) = DSDH_TOP + + NLEVEL = NLAYS + 1 + + IF ( .NOT. ONLY_SOLVE_RAD ) THEN +!***calculate optical depth profiles + TAU_TOT ( NLAYS,IWL ) = TAU_TOT ( NLAYS,IWL ) + DTAU( 1 ) + TAUC_AERO( NLAYS,IWL ) = TAUC_AERO( NLAYS,IWL ) + DT_AERO( 1 ) + TAU_CLOUD( NLAYS,IWL ) = TAU_CLOUD( NLAYS,IWL ) + DT_CLOUD( 1 ) + + DO L = NLAYS-1, 1, -1 + TAU_TOT ( L,IWL ) = TAU_TOT ( L,IWL ) + TAU_TOT ( L+1,IWL ) + TAUC_AERO( L,IWL ) = TAUC_AERO( L,IWL ) + TAUC_AERO( L+1,IWL ) + TAU_CLOUD( L,IWL ) = TAU_CLOUD( L,IWL ) + TAU_CLOUD( L+1,IWL ) + END DO + END IF + +!***Set fluxes to zero + + FDIR = 0.0 + FUP = 0.0 + FDN = 0.0 + EDIR = 0.0 + EUP = 0.0 + EDN = 0.0 + +!***calculate fluxes and irradiances + + CALL TWOSTREAM_S ( NLEVEL, COSZEN, ALB( IWL ), DTAU, OM, G, DSDH_TD, + & FDIR, FUP, FDN, EDIR, EUP, EDN ) + + DO L = 1, NLAYS + II = NLAYS + 2 - L + FSUM( L ) = FDIR( II ) + FDN( II ) + FUP( II ) ! actinic flux + ESUM( L ) = EDIR( II ) + EDN( II ) ! downward irradiance + END DO ! loop over layers + +! add diffusion and direct components for calculating reflectivity and transmissivity + INSOLATION = INSOLATION + SOLAR_FLUX + REFLECTION = REFLECTION + SOLAR_FLUX * EUP( 1 ) + TRANSMISSION = TRANSMISSION + SOLAR_FLUX * EDN( NLEVEL ) + TRANS_DIRECT = TRANS_DIRECT + SOLAR_FLUX * EDIR( NLEVEL ) + + IF ( ONLY_SOLVE_RAD ) CYCLE + +!***FSB Calculate column averaged scattering albedo and asymmetry factor + + IF ( TAUC_AERO( 1,IWL ) .GT. 1.0E-30 ) THEN + SSA_AERO( IWL ) = TAU_SCAT( IWL ) / TAUC_AERO( 1,IWL ) + END IF + + TOTAL_TAU_CLD( IWL ) = TAU_CLOUD( 1,IWL ) + +#ifdef phot_debug + IF ( TAU_CLOUD( 1,IWL ) .GT. 1.0E-20 ) THEN + IF ( AVE_ASYMM_CLD( IWL ) .GT. TAU_SCAT_CLD ) THEN + WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) + & 'Sum for AVE_ASYMM_CLD at L(', 1,') = ', AVE_ASYMM_CLD( IWL ), + & 'Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'AVE_ASYMM_CLD Increment = ', G_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'TAU_SCAT_CLD Increment = ', + & DTSCAT_CLOUD + END IF + IF ( TAU_SCAT_CLD .GT. 1.0E-20 ) THEN + AVE_ASYMM_CLD( IWL ) = AVE_ASYMM_CLD( IWL ) / TAU_SCAT_CLD + AVE_SSA_CLD ( IWL ) = TAU_SCAT_CLD / TAU_CLOUD( 1,IWL ) + ELSE + AVE_ASYMM_CLD( IWL ) = 0.0 + AVE_SSA_CLD ( IWL ) = 0.0 + END IF + IF ( ABS( AVE_ASYMM_CLD( IWL ) ) .GE. 1.0 ) THEN + WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) + & 'Sum for AVE_ASYMM_CLD at L(', 1,') = ', AVE_ASYMM_CLD( IWL )*TAU_SCAT_CLD, + & 'Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'AVE_ASYMM_CLD Increment = ', G_CLOUD + WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) + & 'TAU_SCAT_CLD Increment = ', DTSCAT_CLOUD + END IF + ELSE + TOTAL_TAU_CLD( IWL ) = 0.0 + AVE_SSA_CLD ( IWL ) = 0.0 + AVE_ASYMM_CLD( IWL ) = 0.0 + END IF +#endif + +!***FSB capture the total downward irradiance at the surface [ W / m**2] +! +! ETOT_SFC( IWL ) = CONV_WM2( IWL ) * FLXSCALE * FEXT( IWL ) +! & * ESUM( 1 ) + + FORALL( L = 1:NLAYS ) +!***multiply by the solar flux at the domain top for +!***actinic flux and irradiance; keeping actinic flux in photons/(cm^2*s) + ACTINIC_FLUX( L,IWL ) = SOLAR_FLUX * FSUM( L ) + IRRADIANCE ( L,IWL ) = SOLAR_FLUX * CONV_WM2( IWL ) * ESUM( L ) + END FORALL + END DO ! loop over wavelengths + +! normalize reflection and transmission coefficients + INSOLATION = 1.0 / ( COSZEN * INSOLATION ) + TRANS_DIRECT = TRANS_DIRECT * INSOLATION + REFLECTION = ONE_OVER_PI * REFLECTION * INSOLATION + TRANSMISSION = ONE_OVER_PI * TRANSMISSION * INSOLATION + + IF ( ONLY_SOLVE_RAD ) RETURN + +! compute photolysis rates + DO IPHOT = 1, NPHOTAB + DO IWL = 1, NWL + DO L = 1, NLAYS + BLKRJ( L,IPHOT ) = BLKRJ( L,IPHOT ) + & + ACTINIC_FLUX( L,IWL ) + & * CSZ( L,IWL,IPHOT ) * QYZ( L,IWL,IPHOT ) ! [ 1 / sec ] + END DO + END DO + END DO ! loop on layers, wavelength, IPHOT +! convert actinic flux to watts/m^2 + FORALL( L = 1:NLAYS, IWL=1:NWL ) + ACTINIC_FLUX( L,IWL ) = ACTINIC_FLUX( L,IWL ) * CONV_WM2( IWL ) + END FORALL + +!***compute rate of photolysis (j-values) for each reaction + +9503 FORMAT('LAYER = ',I3,' MODE = ',I3,' LAMBDA(nm) = ',ES12.4,' DGN_CORE(m) = ',ES12.4, + & ' DGN_SHELL(m) = ', ES12.4 / ' REFRACT_IDX_SHELL(NR,NI) = ', 2(ES12.4,1X), + & ' REFRACT_IDX_CORE(NR,NI) = ', 2(ES12.4,1X) / ' LN(GEO.STD.DEV.) = ', + & ES12.4) +9504 FORMAT('LAYER = ',I3,' MODE = ',I3,' LAMBDA(nm) = ',ES12.4,' DGN(m) = ',ES12.4, + & ' REFRACT_IDX(NR,NI) = ', 2(ES12.4,1X) / ' VOL.DENS. = ', ES12.4, + & ' LN(GEO.STD.DEV.) = ', ES12.4) + +99985 FORMAT('ERROR: Modeled Troposheric Ozone Column downward from layer ',I3,1X) +99986 FORMAT('exceeds Top Ozone Column based on OMI.data file. Negative Optical Depths ') +99987 FORMAT('but are physically unlikey.') +99988 FORMAT(' SETTING O3 Column ABOVE PTOP TO 25% of OMI.dat value ') +99989 FORMAT(' FOR ROW/COL = ',2(1X,I4)) + + RETURN + END SUBROUTINE NEW_OPTICS + +C/////////////////////////////////////////////////////////////////////// + + SUBROUTINE GETSRAY ( NWL, LAMDA, SRAYL ) +C----------------------------------------------------------------------- +C calculate molecular (Rayleigh) scattering cross section, srayl +C +C coded 09/08/2004 by Dr. Francis S. Binkowski +C Carolina Environmental Program +C University of North Carolina at Chapel Hill +C email: frank_binkowski@unc.edu +C +C Reference: +C Nicolet, M., On the molecular scattering in the terrestrial +C atmosphere: An empirical formula for its calculation in the +C homoshpere, Planetary and Space Science. Vol. 32,No. 11, +C Pages 1467-1468, November 1984. +C----------------------------------------------------------------------- + + IMPLICIT NONE + +!***arguments + + INTEGER, INTENT( IN ) :: NWL ! number of wavelength bins + REAL, INTENT( IN ) :: LAMDA( : ) ! wavelengths [nm] + REAL, INTENT( OUT ) :: SRAYL( : ) ! molecular scattering cross sections [cm**2] + +!***Internal variables + + INTEGER I + REAL WMICRN ! wavelenght in micrometers + REAL WMICRN1 ! 1 / wmicrn + REAL XX ! variable in Nicolet method + +!***get molecular scattering cross section. This is a fixed +!*** function of wavelength. + + DO I = 1, NWL + WMICRN = 1.0E-3 * LAMDA( I ) ! wavelength in micrometers + WMICRN1 = 1.0 / WMICRN + + IF ( WMICRN .LE. 0.55 ) THEN + XX = 3.6772 + 0.389 * WMICRN + 0.09426 * WMICRN1 + ELSE + XX = 4.04 + END IF + + SRAYL( I ) = 4.02E-28 * WMICRN1**XX ! in [cm**2] + + END DO + + RETURN + END SUBROUTINE GETSRAY + + + SUBROUTINE GET_TAUO3 ( IWL, STOZONE, STRAT_TEMP, TAU_O3 ) +C----------------------------------------------------------------------- +C subroutine to calculate the optical depth of ozone in the +C stratosphere +C +C special cross sections for calculating stratospheric ozone +C optical depth +C +C the following temperatures and cross sections are from +C Fast-J +C REFERENCE: +C Wild, O., X. Zhu, and M.J. Prather, Fast-J: Accurate simulation +C of in- and below-clolud photolysis in tropospheric chemical +C models, +C Journal of Atmospheric Chemistry, Vol. 37, pp 245-282, 2000 +C +C coded 10/20/2004 by Dr. Francis S. Binkowski +C Carolina Environmental Program +C University of North Carolina at Chapel Hill +C email: frank_binkowski@unc.edu +C Updated to Fast-JX version 5.0 +C Mar 2011 Bill Hutzell +C revised interpolation method for a general number of +C interpolation points +C +C----------------------------------------------------------------------- + + IMPLICIT NONE + +!***arguments + + INTEGER, INTENT( IN ) :: IWL ! wavelenth index + + REAL, INTENT( IN ) :: STOZONE ! ozone column amount [ DU ] + REAL, INTENT( IN ) :: STRAT_TEMP ! average temperature for stratosphere [ K ] + REAL, INTENT( OUT ) :: TAU_O3 ! optical depth for statosphere + +!***Local + + INTEGER IXT, IXTEMP + + REAL OZONE_CS ! interpolated ozone absorption cross section + REAL YTT ! interpolation variable + +!***Find temperature range: + + IF ( STRAT_TEMP .LE. TEMP_O3_STRAT( 1 ) ) IXTEMP = 0 + + DO IXT = 1, NTEMP_STRAT - 1 + IF ( STRAT_TEMP .GT. TEMP_O3_STRAT( IXT ) .AND. + & STRAT_TEMP .LT. TEMP_O3_STRAT( IXT + 1 ) ) THEN + IXTEMP = IXT + YTT = ( STRAT_TEMP - TEMP_O3_STRAT( IXT ) ) + & / ( TEMP_O3_STRAT( IXT + 1 ) - TEMP_O3_STRAT( IXT ) ) + END IF + END DO + + IF ( STRAT_TEMP .GE. TEMP_O3_STRAT( NTEMP_STRAT ) ) THEN + IXTEMP = NTEMP_STRAT + YTT = 0.0 + END IF + +!***do linear interpolation + + IF ( IXTEMP .EQ. 0 ) THEN + OZONE_CS = XO3CS( 1, IWL ) + ELSE IF ( IXTEMP .GE. 1 .AND. IXTEMP .LT. NTEMP_STRAT ) THEN + OZONE_CS = XO3CS( IXTEMP, IWL ) + + & ( XO3CS( IXTEMP+1, IWL ) - XO3CS( IXTEMP, IWL ) ) * YTT + ELSE IF ( IXTEMP .EQ. NTEMP_STRAT ) THEN + OZONE_CS = XO3CS( IXTEMP, IWL ) + END IF + + TAU_O3 = DU_TO_CONC * STOZONE * OZONE_CS + + RETURN + END SUBROUTINE GET_TAUO3 + +C/////////////////////////////////////////////////////////////////////// + + SUBROUTINE O3AMT ( XLAT, XLONG, MDAY, OZONE ) +C----------------------------------------------------------------------- +C This subroutine implements an algorithm for the annual behavior +C of total ozone ( taken here to be stratospheric) from +C climatology +C Reference: +C Van Heuklon, Thomas K., Estimating atmospheric ozone for solar +C radiation models, Solar Energy, Vol. 22, pp 63-68, 1979. +C updated from an earlier version by +C Dr. Francis S. Binkowski, The Carolina Environmental Program, +C The University of North Carolina at Chapel Hill. +C Email: frank_binkowski@unc.edu +C November 03. 2004. +C Only Northern Hemisphere is implemented. +C----------------------------------------------------------------------- + + IMPLICIT NONE + +!***arguments + + INTEGER, INTENT( IN ) :: MDAY ! Day number during the year + ! Jan 1st = 1.0, Feb 1st = 32, etc. + + REAL, INTENT( IN ) :: XLAT ! latitude of point on earth's surface + REAL, INTENT( IN ) :: XLONG ! longitude of point on earth's surface + REAL, INTENT( OUT ) :: OZONE ! Total column amount of ozone [ DU ] + +!***Internal: + +!***The following parameters are from Table 1 of Van Heuklon (1979). + + REAL, SAVE :: A, B, C, D, F, G, H, FJ + DATA A/150.0/, B/1.28/, C/40.0/, D/0.9865/, F/-30.0/, G/20.0/, + & H/3.0/, FJ/235.0/ + +!***FSB FJ is the equatorial annual average of atmospheric ozone +!*** content, as noted on page 65 of Nav Heulklon (1979). This value +!*** sets the basic background for ozone. + + REAL, PARAMETER :: RD = 0.017453 ! degrees to radians + +!***Variables of convenience + + REAL E, FI, BPHI, DEF, HLI, SINB, SINB2 + +!***set the day + + E = FLOAT( MDAY ) + FI = 20.0 + IF ( XLONG .LT. 0.0 ) FI = 0.0 + BPHI = B * XLAT * RD + DEF = D * ( E + F ) * RD + HLI = H * ( XLONG + FI ) * RD + SINB = SIN( BPHI ) + SINB2 = SINB * SINB + +!***the following equation implements equation (4) of VanHeuklon (1979) + + OZONE = FJ + ( A + C * SIN( DEF ) + G * SIN( HLI ) ) * SINB2 + + RETURN + END SUBROUTINE O3AMT + +C/////////////////////////////////////////////////////////////////////// + + SUBROUTINE SLANTPATH2 ( NLAYS, Z, ZSFC, REARTH, SINZEN, DZ, DSDH ) +C----------------------------------------------------------------------- +C PURPOSE: +C Calculate slant path, ds/dh, over vertical depth in spherical +C geometry also calculates the layer thicknesses. +C NOTE!!! +C This version is restricted to zenith angle less than 90 degrees +C----------------------------------------------------------------------- +C ARGUMENTS: +C INPUT: +C NLAYS - INTEGER, number of specified altitude levels +C z - REAL, altitude (agl) [m] <<< meters +C This is from file ZF ( full layers ) from METCRO3D +C Z(1) is zero. +C zsfc - REAL, ground elevation (msl) [m] +C rearth - REAL, radius of the earth [m] +C sinzen - REAL, sine of solar zenith angle +C +C OUTPUT: +C dz - REAL, layer thicknesses [ m ] +C dsdh - REAL, slant path of direct beam through each layer +C when travelling from the top of the atmosphere downward +C----------------------------------------------------------------------- +C EDIT HISTORY: +C Inspired by sphers from TUV +C 09/08/2004 modified to specialize for CMAQ application +C by Dr. Francis S. Binkowski +C Environmental Modeling for Policy Development group, +C The Carolina Environmental Program +C The University of North Carolina-Chapel Hill +C Email: frank_binkowski@unc.edu +C +C----------------------------------------------------------------------- +C REFERENCE: +C Dahlback, A. and K. Stamnes, A new spherical model for computing +C the radiation field available for photolysis and heating at +C twilight, Planetary and Space Sciences, Vol. 39, No. 5, +C pp 671-683, 1991. +C +C----------------------------------------------------------------------- + + IMPLICIT NONE + +!***arguments + + INTEGER, INTENT( IN ) :: NLAYS + + REAL, INTENT( IN ) :: Z ( : ) + REAL, INTENT( IN ) :: ZSFC + REAL, INTENT( IN ) :: REARTH + REAL, INTENT( IN ) :: SINZEN + REAL, INTENT( OUT ) :: DZ ( : ) ! layer thicknesses counting from surface upward + REAL, INTENT( OUT ) :: DSDH( : ) + +!***Internal + + INTEGER I, J, K ! loop indices + REAL RE + REAL DSJ ! slant path length [m] + REAL DHJ ! layer thickness [m] + REAL( 8 ) :: RJ, RJP1 + REAL( 8 ) :: RPSINZ ! rpsinz = (re + zd(i)) * sinzen + REAL( 8 ) :: RPSINZ2 ! rpsinz * rpsinz + REAL( 8 ) :: GA, GB ! see usage + REAL :: ZE( NLAYS + 1 ) ! altitudes MSL + REAL :: ZD( NLAYS + 1 ) ! array of altitudes indexed from top + REAL :: DZI( NLAYS ) ! layer thicknesses counting downward from the top + +C----------------------------------------------------------------------- + +!***re include the altitude above sea level to the radius of the earth + + RE = REARTH + ZSFC + +!***ze is the altitude above msl + + DO K = 1, NLAYS + 1 + ZE( K ) = Z( K ) +!!sjr ZE(K) = Z(K) - ZSFC + END DO + +!*** DZ(1) = ZE(2) - ZE(1) +!*** DZI(1) = ZE(NLAYS + 1) - ZE(NLAYS) + +!***calculate dz + + DO K = 1, NLAYS + DZ( K ) = ZE( K + 1 ) - ZE( K ) + END DO + +!***zd, dzi are inverse coordinates of ze & dz + + DO K = 1, NLAYS + 1 + J = NLAYS + 1 - K + 1 + ZD( J ) = ZE( K ) + END DO + + DO K = 1, NLAYS + J = NLAYS + 1 - K + DZI( J ) = DZ( K ) + END DO + +!***initialize dsdh + + DO I = 1, NLAYS + DSDH( I ) = 0.0 + END DO + +!***FSB The following code is a direct implementation of appendix B +!*** of Dahlbeck and Stamnes (1991) for the case of solar zenith +!*** angle less than 90 degree. + +!***calculate ds/dh of every layer starting at the top + + DO J = 1, NLAYS +!*** K = NLAYS - J +1 + RPSINZ = REAL( ( RE + ZD( J ) ) * SINZEN , 8 ) + RPSINZ2 = RPSINZ * RPSINZ + + IF ( J .LT. NLAYS ) THEN + RJ = REAL( RE + ZD( J ), 8 ) + RJP1 = REAL( RE + ZD( J + 1 ), 8 ) + DHJ = DZI( J ) + ELSE + RJ = REAL( RE + ZD( J ), 8) + RJP1 = REAL( RE, 8 ) + DHJ = DZI( J ) + END IF + +!***define GA and GB + + GB = SQRT( MAX( 0.0D0, RJ * RJ - RPSINZ2 ) ) + GA = SQRT( MAX( 0.0D0, RJP1 * RJP1 - RPSINZ2 ) ) + +!***This is equation B1 from Dahlbeck and Stamnes (1991) + + DSJ = ABS( REAL(GB - GA, 4 ) ) + +!***this is the slant path (Chapman) function. + + DSDH( J ) = DSJ / DHJ ! Note dsdh is on a top to bottom grid. + + END DO ! loop over altitude + + RETURN + END SUBROUTINE SLANTPATH2 + +C/////////////////////////////////////////////////////////////////////// + + SUBROUTINE SLANTPATHTOP ( ZTOM, ZTOA, ZSFC, REARTH, SINZEN, + & DSDHTOP ) +C----------------------------------------------------------------------- +C FSB This is a SPECIAL version to get the slant path from the top of +C the modeling domain (ztom) to the top of the atmosphere (ztoa). +C----------------------------------------------------------------------- +C PURPOSE: +C Calculate slant path, ds/dh, over vertical depth in spherical +C geometry also calculates the layer thicknesses. +C NOTE!!! +C This version is restricted to zenith angle less than 90 degrees +C----------------------------------------------------------------------- +C ARGUMENTS: +C INPUT: +C ztom - REAL, altitude (agl) of top of modeling domain [m] << size(x)) + IntegrateTrapezoid = sum((y(1+1:n-0) + y(1+0:n-1))*(x(1+1:n-0) - x(1+0:n-1)))/2 + end associate + end function + +! --------------------------------------------------------------------------- + + function interp_linear1_internal(x,y,xout) result(yout) + !! Interpolates for the y value at the desired x value, + !! given x and y values around the desired point. + + implicit none + + real, intent(IN) :: x(2), y(2), xout + real :: yout + real :: alph + + if ( xout .lt. x(1) .or. xout .gt. x(2) ) then + write(*,*) "interp1: xout < x0 or xout > x1 !" + write(*,*) "xout = ",xout + write(*,*) "x0 = ",x(1) + write(*,*) "x1 = ",x(2) + stop + end if + + alph = (xout - x(1)) / (x(2) - x(1)) + yout = y(1) + alph*(y(2) - y(1)) + + return + + end function interp_linear1_internal + + end module centralized_io_util_module diff --git a/src/model/src/phot.F b/src/model/src/phot.F new file mode 100644 index 0000000..66c9531 --- /dev/null +++ b/src/model/src/phot.F @@ -0,0 +1,1251 @@ + +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + + +! RCS file, release, date & time of last delta, author, state, [and locker] +! $Header: /project/yoj/arc/CCTM/src/phot/phot_inline/phot.F,v 1.7 2011/10/21 16:11:28 yoj Exp $ + +! what(1) key, module and SID; SCCS file; date and time of last delta: +! %W% %P% %G% %U% + +!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) + +!----------------------------------------------------------------------- +! +! Function: Calculates the photolysis rate constant to be used by the +! chemical solver. It calculates these rates at each gridcell using +! codes adapted from JPROC. Cloud correction now called within the +! loops over MY-ROW & MY_COLS +! +! Preconditions: HGRD_INIT() called from PAR_INIT, which is called from +! DRIVER +! +! Subroutines/Functions called: INIT3, M3EXIT, SUBHFILE, CGRID_MAP, +! OPPHOT, LOAD_CSQY_DATA, LOAD_OPTICS_DATA, INITIALIZE_ALBEDO, +! GET_PHOT_MET, UPDATE_SUN, GET_ALBEDO, GET_DROPLET_OPTICS, +! GET_ICE_OPTICS, GET_AGGREGATE_OPTICS, CLEAR_HYDROMETEOR_OPTICS, +! GET_AERO_DATA, O3TOTCOL, and NEW_OPTICS +! +! Revision History. +! Started 10/08/2004 with existing PHOT and JPROC coded by +! Dr. Francis S. Binkowski +! Carolina Environmental Program +! University of North Carolina at Chapel Hill +! email: frank_binkowski@unc.edu +! August 2005, Sarav Arunachalam, CEP, UNC-CH +! - Minor revisions while integrating with CMAQ +! - Error check for NPHOTS added (this version works only for SAPRC-99) +! - Added creation of new file CTM_RJ_1 to write out RJ values +! for O3 and NO2 (both clear sky and cloud effects), and +! ETOT_SFC, TAU_AERO, TAU_TOT and TAUO3_TOP values for 7 wavelengths +! June 2007, David Wong +! -- inline with CMAQ +! - declare RJ as assumed shape array to match with the caller routine +! - allow PE 0 only to open the output file +! - output species: NO2_CLOUD and O3_CLOUD with AMISS value when all cells +! are dark and JTIME_CHK = 0 +! - output species: NO2_CLOUD and O3_CLOUD with AMISS value when CLDATT is +! 0 and JTIME_CHK = 0 +! December 2007, Francis Binkowski +! code has been modified to call the new on-line version that +! has the cloud effects built in. new photolysis routine to +! replace PHOT in CMAQ +! January 2008, Shawn Roselle +! - reformatted for inclusion in CMAQ +! - added additional 3-d photolysis rate diagnostic file +! - moved code for opening the diagnostic files to a separate subroutine +! - moved aerosol pointer evaluation to a FORTRAN module +! - simplified code for writing the diagnostic file +! - changed code to call NEW_OPTICS twice, once for clear sky and +! another time for the cloudy fraction of the grid cell. RJ's are +! computed based on the cloud fraction weighting. +! March 2011, Bill Hutzell +! - enable wavelength dependent arrays to have an allocatable number +! of wavelength bins +! - added data structure and algorithm to compute a surface albedo that +! depends on time and landuse catagory based on work by John Striecher +! (AMAD/USEPA) +! - revised writing to RJ1 file to include surface albedo +! - moved photolysis and opacity data from CSQY module to an ASCII input +! file +! - added routine called LOAD_REF_DATA (inside the PHOT_MOD module) that i +! reads this input file +! - added call to a routine called AERO_PHOTDATA that returns opacity data +! on the aerosol distribution +! - revised NEW_OPTICS' arguments based on aerosol redesign in CMAQ +! version 5.0 +! March 29, 2011 S.Roselle +! - Replaced I/O API include files with UTILIO_DEFN +! 07 Jul 14 B.Hutzell: replaced mechanism include file(s) with fortran module +! 26 Sep 14 B.Hutzell: 1) moved calculation of surface albedo to its own +! fortran module +! 2) changed loading procedure for loading optical data; +! two files now used +! 3) reading and calculation of met and geo data +! now acomplished by a fortran module +! 4) changed description and accounting of cloud effects +! from 2D liquid water clouds to 3D resolved and subgrid +! clouds with multi-phases of water +! 5) inserted calculation of aerosol optical properites via +! fortran module to improve efficiency in radiative +! transfer solution +! 6) moved the O3TOTCOL routine from the PHOT_MOD to simplify +! the NEW_OPTICS routine +! 7) Several miscellaneous changes attempting to improve efficiency +! June 10 15 J.Young: Modified diagnostic output timestamp to fix for other than one +! hour time steps. +! Aug 12, 15 D. Wong: Replaced MYPE with IO_PE_INCLUSIVE for parallel I/O implementation + +!---------------------------------------------------------------------- + +C...modules + + USE RXNS_DATA ! chemistry varaibles and data + USE CGRID_SPCS ! CGRID species number and offsets + USE PCGRID_DEFN ! get cgrid + USE UTILIO_DEFN + USE AERO_DATA ! describes aerosol distribution + USE PHOT_MOD ! photolysis in-line module - inherits CSQY_DATA module + USE AERO_PHOTDATA ! arrays and routines for aerosol dimensions and refractive indices + USE PHOTOLYSIS_ALBEDO ! surface albedo data and routines + USE PHOT_MET_DATA ! Met and Grid data + USE CLOUD_OPTICS ! data and routines for optics of cloud hydrometeors +! USE STRATOS_O3_MINFRACS ! annual minimum fraction of ozone column density above Pressure TOP +! USE SEAS_STRAT_O3_FRACS ! monthly minimum fraction of ozone column density above Pressure TOP + USE SEAS_STRAT_O3_MIN ! monthly minimum fraction of ozone column density above Pressure TOP + +#ifdef parallel + USE SE_MODULES ! stenex (using SE_UTIL_MODULE) +#else + USE NOOP_MODULES ! stenex (using NOOP_UTIL_MODULE) +#endif + + IMPLICIT NONE + +!...include files + + INCLUDE SUBST_FILES_ID ! file name parameters +! INCLUDE SUBST_CONST ! physical constants--moved to PHOT_MOD. + +!...arguments + + INTEGER, INTENT( IN ) :: MDATE ! "centered" Julian date (YYYYDDD) + INTEGER, INTENT( IN ) :: MTIME ! "centered" time (HHMMSS) + INTEGER, INTENT( IN ) :: JDATE ! current Julian date (YYYYDDD) + INTEGER, INTENT( IN ) :: JTIME ! current time (HHMMSS) + INTEGER, INTENT( IN ) :: DTSTEP( : ) ! time step vector (HHMMSS) + +! REAL RJ( NCOLS,NROWS,NLAYS, NPHOTAB ) + REAL, INTENT( OUT ) :: RJ( :,:,:,: ) ! gridded J-values (1/min units) + +! REAL CGRID( NCOLS,NROWS,NLAYS, * ) ! Conc array + REAL, SAVE, POINTER :: CGRID( :,:,:,: ) ! species concentrations + +!...parameters + + LOGICAL, PARAMETER :: CLDATT = .TRUE. ! include cloud attenuation + + REAL, PARAMETER :: DENS_CONV = ( 1.0E+03 * AVO / MWAIR ) * 1.0E-06 ! convert from kg/m**3 to #/cc + REAL, PARAMETER :: PPM_MCM3 = 1.0E-06 ! convert from ppm to molecules / cc mol_Spec/mol_Air = ppm * 1E-06 + REAL, PARAMETER :: PRES_CONV = 1.0 / STDATMPA ! conversion factor Pa to atm + REAL, PARAMETER :: ZTOA = 50.0E3 ! height of top of atmosphere [ m ] (=50km) + ! based a 2005 WRF model Documentation + + REAL, PARAMETER :: EPSLON = 1.0E-30 ! Small number + +!...external functions: none + +!...local variables + + LOGICAL, SAVE :: FIRSTIME = .TRUE. ! Flag for first call to PHOT + LOGICAL, SAVE :: PHOTDIAG ! Flag for PHOTDIAG file + + LOGICAL, SAVE :: CALL_INIT_ALBEDO = .TRUE. + LOGICAL, SAVE :: CALL_GET_ALBEDO = .TRUE. + + LOGICAL :: ZERO_ICE + + CHARACTER( 3 ), ALLOCATABLE, SAVE :: WLTXT( : ) + CHARACTER( 16 ) :: VARNM + CHARACTER( 16 ), SAVE :: PNAME = 'PHOT' + CHARACTER( 16 ), SAVE :: CTM_PHOTDIAG = 'CTM_PHOTDIAG' + + CHARACTER( 80 ) :: VARDESC ! environment variable description + CHARACTER( 240 ) :: XMSG = ' ' + + INTEGER, SAVE :: LOGDEV + INTEGER, SAVE :: LGC_O3 ! pointer to O3 in CGRID + INTEGER, SAVE :: LGC_NO2 ! pointer to NO2 in CGRID + INTEGER, SAVE :: TSTEP ! output timestep in sec + + INTEGER ESTAT ! status from environment var check + INTEGER IPHOT ! photolysis rate loop index + INTEGER ROW + INTEGER COL + INTEGER LEV + INTEGER SPC + INTEGER IWL + INTEGER L + INTEGER V, N, MODE + LOGICAL JTIME_CHK ! To check for JTIME to write RJ values + INTEGER ODATE ! output date + INTEGER OTIME ! output time + + INTEGER ALLOCSTAT + + INTEGER, SAVE :: TDATE + INTEGER, SAVE :: GXOFF, GYOFF ! global origin offset from file + INTEGER, SAVE :: PECOL_OFFSET ! Local Column Offset for processor + INTEGER, SAVE :: PEROW_OFFSET ! Local Column Offset for processor + INTEGER, SAVE :: TSTEP_COUNT ! counter between calls to write diagnostics + +! for INTERPX + INTEGER, SAVE :: STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 + INTEGER, SAVE :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + + REAL CURRHR ! current GMT hour + REAL JULIAN_DAY ! time of year [days] + REAL CURRHR_LST ! local standard time at each grid cell + REAL CTOP ! cloud top in single dimension + REAL CBASE ! cloud base in single dimension + REAL ZLEV ! height in single dimension + REAL ZEN ! cosine of zenith angle + REAL SINLAT ! sine of latitude + REAL COSLAT ! cosine of latitude + REAL RSQD ! square of soldist + REAL ZSFC ! surface height (msl) [ m ] + REAL EQT ! equation of time + REAL SOLDIST ! solar distance [ au ] + REAL SINDEC ! sine of the solar declination + REAL COSDEC ! cosine of the solar declination + REAL COSZEN ! working cosine of the solar zenith angle + REAL SINZEN ! working sine of the solar zenith angle + REAL LATCR ! local latitude + REAL LONCR ! local longitude + REAL OWATER_FRAC ! Open water fraction + REAL SNOW_FRAC ! Snow fractional coverage + REAL SEAICE_FRAC ! Sea Ice fraction + REAL RES_SKY_REFLECT ! reflection coefficient based on resolved sky + REAL RES_SKY_TRANS ! diffuse transmission coefficient based on resolved sky + REAL RES_SKY_TRANSD ! direct transmission coefficient based on resolved sky + + REAL :: TOTAL_O3_COLUMN ! total ozone column density, DU + + REAL, SAVE :: JYEAR = 0.0 ! year + REAL, SAVE :: JD_STRAT_O3MIN = 0.0 ! Julian day (YYYYDDD) of min fraction for stratos ozone + + INTEGER, PARAMETER :: DAYS( 12 ) = (/ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30 /) + INTEGER, SAVE :: IMONTH = 0 + + REAL, ALLOCATABLE, SAVE :: ETOT_SFC ( : ) ! total downward irradiance at sfc [ Watts / m**2 ] + REAL, ALLOCATABLE, SAVE :: TAUO3_TOP( : ) ! optical depth of ozone above model domain + REAL, ALLOCATABLE, SAVE :: TAU_RAY ( : ) ! Rayleigh optical depth above model domain + REAL, ALLOCATABLE, SAVE :: TAUC_AERO( :,: ) ! aerosol optical depth at layer bottom + REAL, ALLOCATABLE, SAVE :: TAU_TOT ( :,: ) ! total optical depth at layer bottom + REAL, ALLOCATABLE, SAVE :: TAU_CLOUD( :,: ) ! cloud optical depth at layer bottom + + REAL, ALLOCATABLE, SAVE :: SSA ( : ) ! aerosol single scattering albedo, column average + + REAL MSCALE ! combined factor to scale ppm to Molecules / cm**3 + ! and correct for ambient temperaure and pressure + +! FSB new arrays for new on-line cloud version + + REAL, ALLOCATABLE, SAVE :: LWC ( : ) ! cloud liquid water content [ g/m**3 ] + REAL, ALLOCATABLE, SAVE :: RWC ( : ) ! rain water content [ g/m**3 ] + REAL, ALLOCATABLE, SAVE :: IWC ( : ) ! ice liquid water content [ g/m**3 ] + REAL, ALLOCATABLE, SAVE :: SWC ( : ) ! snow content [ g/m**3 ] + REAL, ALLOCATABLE, SAVE :: GWC ( : ) ! graupel content [ g/m**3 ] + REAL, ALLOCATABLE, SAVE :: CLDFRAC( : ) ! fractional cloud cover + REAL, ALLOCATABLE, SAVE :: BLKPRS ( : ) ! Air pressure in [ Pa ] + REAL, ALLOCATABLE, SAVE :: BLKTA ( : ) ! Air temperature [ K ] + REAL, ALLOCATABLE, SAVE :: BLKDENS( : ) ! Air density [ molecules / m**3 ] + REAL, ALLOCATABLE, SAVE :: BLKZH ( : ) ! layer half-height [ m ] + REAL, ALLOCATABLE, SAVE :: BLKO3 ( : ) ! O3 concentration [ molecules/cm**3 ] + REAL, ALLOCATABLE, SAVE :: BLKNO2 ( : ) ! NO2 concentration [ molecules/cm**3 ] + REAL, ALLOCATABLE, SAVE :: BLKZF ( : ) ! layer full-height [ m ] + + REAL, ALLOCATABLE, SAVE :: BLKRJ_RES( :, : ) ! photolysis rates + REAL, ALLOCATABLE, SAVE :: BLKRJ_ACM( :, : ) ! photolysis rates + + LOGICAL, ALLOCATABLE, SAVE :: CLOUDS( : ) ! Does layer have clouds? + LOGICAL :: NEW_PROFILE ! Has atmospheric temperature and density profile changed? + LOGICAL :: DARK ! Are this processor's cells in darkness? + +!...Variables for diagnostic outputs + + REAL, ALLOCATABLE, SAVE :: N_EXCEED_TROPO3( :,: ) ! Number of adjustments tropospheric ozone optical depth + + REAL, ALLOCATABLE, SAVE :: TOTAL_OC( :,: ) ! total ozone column [DU] + REAL, ALLOCATABLE, SAVE :: TROPO_OC( :,: ) ! tropospheric ozone column [DU] + REAL, ALLOCATABLE, SAVE :: TROPO_O3_EXCEED( :,: ) ! Factor used to adjust tropospheric ozone optical depth + REAL, ALLOCATABLE, SAVE :: TRANSMIS_DIFFUSE( :,: ) ! diffuse transmission coefficient at surface + REAL, ALLOCATABLE, SAVE :: TRANSMIS_DIRECT( :,: ) ! direct transmission coefficient at surface + REAL, ALLOCATABLE, SAVE :: REFLECT_COEFF( :,: ) ! reflection coefficient at top of atmosphere + REAL, ALLOCATABLE, SAVE :: ETOT_SFC_WL ( :,:,: ) ! total downward irradiance at sfc [ Watts / m**2 ] + REAL, ALLOCATABLE, SAVE :: TAU_AERO_WL ( :,:,: ) ! total aerosol optical depth + REAL, ALLOCATABLE, SAVE :: TAU_CLOUD_WL( :,:,: ) ! total cloud optical depth + REAL, ALLOCATABLE, SAVE :: CLR_TRANSMISSION( :,: ) ! diffuse transmission coefficient of clouds + REAL, ALLOCATABLE, SAVE :: CLR_REFLECTION ( :,: ) ! reflection coefficient of cloud + REAL, ALLOCATABLE, SAVE :: CLR_TRANS_DIRECT( :,: ) ! direct transmission coefficient of clouds +#ifdef phot_debug + REAL, ALLOCATABLE, SAVE :: ASY_CLOUD_WL( :,:,: ) ! columm average of cloud asymmetry factor + REAL, ALLOCATABLE, SAVE :: SSA_CLOUD_WL( :,:,: ) ! columm average of cloud single scattering albedo +#endif + REAL, ALLOCATABLE, SAVE :: TAU_TOT_WL ( :,:,: ) ! total optical depth + REAL, ALLOCATABLE, SAVE :: TAUO3_TOP_WL( :,:,: ) ! optical depth of ozone above model domain + + REAL, ALLOCATABLE, SAVE :: AERO_SSA ( :,:,:,: ) ! aerosol single scattering albedo + REAL, ALLOCATABLE, SAVE :: AERO_ASYM ( :,:,:,: ) ! aerosol asymmetry factor + REAL, ALLOCATABLE, SAVE :: TAU ( :,:,:,: ) ! optical depth + REAL, ALLOCATABLE, SAVE :: TAU_AERO ( :,:,:,: ) ! aerosol optical depth + REAL, ALLOCATABLE, SAVE :: ACTINIC_FX( :,:,:,: ) ! net actinic flux [watts/m**2] + + INTERFACE + SUBROUTINE O3TOTCOL ( LATITUDE, LONGITUDE, JDATE, OZONE ) + INTEGER, INTENT( IN ) :: JDATE ! Julian day of the year (yyyyddd) + REAL, INTENT( IN ) :: LATITUDE ! latitude of point on earth's surface + REAL, INTENT( IN ) :: LONGITUDE ! longitude of point on earth's surface + REAL, INTENT( INOUT ) :: OZONE ! total column ozone [DU] + END SUBROUTINE O3TOTCOL + END INTERFACE + +! ---------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + + FIRSTIME = .FALSE. + LOGDEV = INIT3() + + TSTEP = TIME2SEC( DTSTEP( 1 ) ) ! output timestep for phot diagnostic files + + CGRID => PCGRID( 1:MY_NCOLS,1:MY_NROWS,:,: ) + +!...Get photolysis rate diagnostic file flag + + PHOTDIAG = .FALSE. ! default + VARDESC= 'Flag for writing the photolysis rate diagnostic file' + PHOTDIAG = ENVYN( CTM_PHOTDIAG, VARDESC, PHOTDIAG, ESTAT ) + IF ( ESTAT .NE. 0 ) WRITE( LOGDEV, '(5X, A)' ) VARDESC + IF ( ESTAT .EQ. 1 ) THEN + XMSG = 'Environment variable improperly formatted' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + ELSE IF ( ESTAT .EQ. -1 ) THEN + XMSG = + & 'Environment variable set, but empty ... Using default:' + WRITE( LOGDEV, '(5X, A, I9)' ) XMSG, JTIME + ELSE IF ( ESTAT .EQ. -2 ) THEN + XMSG = 'Environment variable not set ... Using default:' + WRITE( LOGDEV, '(5X, A, I9)' ) XMSG, JTIME + END IF + +!...Get met file offsets + + CALL SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, + & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) + CALL SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + PECOL_OFFSET = COLSD_PE( 1, MYPE+1 ) - 1 + PEROW_OFFSET = ROWSD_PE( 1, MYPE+1 ) - 1 + + CALL LOAD_CSQY_DATA( ) + + CALL LOAD_OPTICS_DATA( ) + +!...Allocate array needed to calculation aerosol and cloud optical properties + + CALL INIT_AERO_DATA( ) + + CALL INIT_CLOUD_OPTICS( ) + +!...Initialize Surface albedo method + + IF ( .NOT. INITIALIZE_ALBEDO( JDATE, JTIME, LOGDEV ) ) THEN + XMSG = 'Failure initializing photolysis surface albedo algorithm' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( ETOT_SFC ( NWL ) ) + + ALLOCATE( LWC ( NLAYS ) ) + ALLOCATE( RWC ( NLAYS ) ) + ALLOCATE( IWC ( NLAYS ) ) + ALLOCATE( SWC ( NLAYS ) ) + ALLOCATE( GWC ( NLAYS ) ) + ALLOCATE( BLKPRS ( NLAYS ) ) + ALLOCATE( BLKTA ( NLAYS ) ) + ALLOCATE( BLKDENS( NLAYS ) ) + ALLOCATE( BLKZH ( NLAYS ) ) + ALLOCATE( BLKO3 ( NLAYS ) ) + ALLOCATE( BLKNO2 ( NLAYS ) ) + ALLOCATE( BLKZF ( NLAYS+1 ) ) + ALLOCATE( CLOUDS ( NLAYS ) ) + ALLOCATE( CLDFRAC( NLAYS ) ) + + ALLOCATE( BLKRJ_RES( NLAYS,NPHOTAB ) ) + ALLOCATE( BLKRJ_ACM( NLAYS,NPHOTAB ) ) + + ALLOCATE( TAUO3_TOP( NWL ) ) + ALLOCATE( TAU_RAY ( NWL ) ) + ALLOCATE( SSA ( NWL ) ) + + ALLOCATE( TAU_CLOUD( NLAYS,NWL ) ) + ALLOCATE( TAUC_AERO( NLAYS,NWL ) ) + ALLOCATE( TAU_TOT ( NLAYS,NWL ) ) + + ALLOCATE( TOTAL_OC ( NCOLS,NROWS ) ) + + IF ( PHOTDIAG ) THEN + ALLOCATE( TROPO_OC ( NCOLS,NROWS ) ) + ALLOCATE( TROPO_O3_EXCEED( NCOLS,NROWS ) ) + ALLOCATE( N_EXCEED_TROPO3( NCOLS,NROWS ) ) + ALLOCATE( TRANSMIS_DIFFUSE( NCOLS,NROWS ) ) + ALLOCATE( TRANSMIS_DIRECT ( NCOLS,NROWS ) ) + ALLOCATE( REFLECT_COEFF ( NCOLS,NROWS ) ) + ALLOCATE( CLR_TRANSMISSION( NCOLS,NROWS ) ) + ALLOCATE( CLR_TRANS_DIRECT( NCOLS,NROWS ) ) + ALLOCATE( CLR_REFLECTION ( NCOLS,NROWS ) ) + ALLOCATE( ETOT_SFC_WL ( NCOLS,NROWS,NWL ) ) + ALLOCATE( TAU_AERO_WL ( NCOLS,NROWS,NWL ) ) + ALLOCATE( TAU_CLOUD_WL ( NCOLS,NROWS,NWL ) ) +#ifdef phot_debug + ALLOCATE( SSA_CLOUD_WL( NCOLS,NROWS,NWL ) ) + ALLOCATE( ASY_CLOUD_WL( NCOLS,NROWS,NWL ) ) +#endif + ALLOCATE( TAU_TOT_WL ( NCOLS,NROWS,NWL ) ) + ALLOCATE( TAUO3_TOP_WL( NCOLS,NROWS,NWL ) ) + + N_EXCEED_TROPO3 = 0.0 + TROPO_O3_EXCEED = 0.0 + TSTEP_COUNT = 0 + + DIAG_WVL( 1 ) = 1 + DIAG_WVL( N_DIAG_WVL ) = NWL + + ALLOCATE ( AERO_ASYM( NCOLS,NROWS,NLAYS,N_DIAG_WVL ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating 3D AERO_ASYM' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( AERO_SSA( NCOLS,NROWS,NLAYS,N_DIAG_WVL ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating 3D AERO_SSA' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( TAU_AERO( NCOLS,NROWS,NLAYS,N_DIAG_WVL ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating 3D TAU_AERO' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( TAU( NCOLS,NROWS,NLAYS,N_DIAG_WVL ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating 3D TAU' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( ACTINIC_FX( NCOLS,NROWS,NLAYS,NWL ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating ACTINIC_FX' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +!...write wavelength data to a character array + + ALLOCATE ( WLTXT( NWL ) ) + + DO IWL = 1, NWL + WRITE( WLTXT( IWL ),'(I3.3)' ) INT( WAVELENGTH( IWL ) ) + END DO + +!...open the photolysis rate diagnostic files + + ODATE = JDATE; OTIME = JTIME +#ifndef phot_extra_tstep + CALL NEXTIME ( ODATE, OTIME, DTSTEP( 1 ) ) ! output timestamp ending time +#endif + IF ( IO_PE_INCLUSIVE ) CALL OPPHOT ( ODATE, OTIME, DTSTEP( 1 ) ) + + CALL SUBST_BARRIER + + END IF ! photdiag + +!...set pointers to species O3 and NO2 in CGRID + + VARNM = 'O3' + LGC_O3 = INDEX1( VARNM, N_GC_SPC, GC_SPC ) + IF ( LGC_O3 .LE. 0 ) THEN + XMSG = 'Could not find ' // VARNM // 'in species table' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + + VARNM = 'NO2' + LGC_NO2 = INDEX1( VARNM, N_GC_SPC, GC_SPC ) + IF ( LGC_NO2 .LE. 0 ) THEN + XMSG = 'Could not find ' // VARNM // 'in species table' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + +#ifdef phot_extra_tstep + ELSE + IF ( PHOTDIAG ) THEN + ODATE = JDATE; OTIME = JTIME + CALL NEXTIME ( ODATE, OTIME, DTSTEP( 2 ) ) ! sync time step + END IF +#endif + END IF ! firstime + + IF ( JD_STRAT_O3MIN .NE. JDATE ) THEN +!...set minimum fraction of ozone column above PTOP + + CALL SEASONAL_STRAT_O3( JDATE, JTIME ) + MIN_STRATO3_FRAC = MONTH_STRAT_03_FRAC + MAX_TROPOO3_FRAC = MAX( 1.0 - MONTH_STRAT_03_FRAC, 0.0 ) + WRITE( LOGDEV,*)'PHOT: MIN_STRATO3_FRAC = ',MIN_STRATO3_FRAC + + JD_STRAT_O3MIN = REAL( JDATE, 4) + END IF +!...initialize variables tracking whether stratosphere ozone column satisfies +!...climatological averages. + + O3_TOGGLE_AVE = 0.0 + O3_TOGGLE_MIN = 1.0 + N_TROPO_O3_TOGGLE = 0 + TSTEP_COUNT = TSTEP_COUNT + 1 + + CALL GET_PHOT_MET( JDATE, JTIME, MDATE, MTIME ) + +!...Get cosine of solar parameters and set DARK + + CALL UPDATE_SUN( JDATE, JTIME, MDATE, MTIME ) + + RSQD = DIST_TO_SUN * DIST_TO_SUN + + IF ( MAXVAL( COSINE_ZENITH ) .LE. 0.0 ) THEN + DARK = .TRUE. + ELSE + DARK = .FALSE. + END IF + +!...set surface albedos + + CALL GET_ALBEDO( MDATE, MTIME, LOGDEV, COSINE_ZENITH, LAT, LON ) + +!...SA Write COSINE_ZENITH array at the end of each output tstep + + IF ( PHOTDIAG ) THEN +#ifndef phot_extra_tstep + ODATE = JDATE; OTIME = JTIME + CALL NEXTIME ( ODATE, OTIME, DTSTEP( 2 ) ) ! sync time step +#endif + JTIME_CHK = ( MOD( TIME2SEC( OTIME ), TSTEP ) .EQ. 0 ) +#ifdef parallel_io + IF ( .NOT. IO_PE_INCLUSIVE ) THEN + IF ( .NOT. OPEN3( CTM_RJ_1, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open ' // TRIM(CTM_RJ_1) + CALL M3EXIT( PNAME, ODATE, OTIME, XMSG, XSTAT1 ) + END IF + IF ( .NOT. OPEN3( CTM_RJ_2, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open ' // TRIM(CTM_RJ_2) + CALL M3EXIT( PNAME, ODATE, OTIME, XMSG, XSTAT1 ) + END IF + END IF +#endif + ELSE + JTIME_CHK = .FALSE. + END IF + + +!...If sun below horizon at all cells, zero photolysis rates & exit +!... (assumes sun below horizon at *all* levels!) + + IF ( DARK ) THEN + + RJ = 0.0 + +!...write to the log file, CTM_RJ_1 file and return + + WRITE( LOGDEV, 1003 ) MYPE, JDATE, JTIME + +!...Initialize ETOT_SFC, TAU_AERO, TAU_TOT, TAUO3_TOP to 0.0 + +!...Write data to output diagnostic file + + TOTAL_OC = 0.0 + + IF ( JTIME_CHK ) THEN + + TROPO_OC = 0.0 + ETOT_SFC_WL = 0.0 + TAUO3_TOP_WL = 0.0 + TAU_AERO_WL = 0.0 + TAU_CLOUD_WL = 0.0 +#ifdef phot_debug + SSA_CLOUD_WL = 0.0 + ASY_CLOUD_WL = 0.0 +#endif + TAU_TOT_WL = 0.0 + TAU = 0.0 + TAU_AERO = 0.0 + AERO_SSA = 0.0 + AERO_ASYM = 0.0 + ACTINIC_FX = 0.0 + +! TROPO_O3_EXCEED = 0.0 + TRANSMIS_DIFFUSE = 0.0 + TRANSMIS_DIRECT = 0.0 + REFLECT_COEFF = 0.0 + CLR_TRANSMISSION = 0.0 + CLR_TRANS_DIRECT = 0.0 + CLR_REFLECTION = 0.0 + + END IF ! if JTIME_CHK + + ELSE ! all cells not dark + +!...MAIN loop over all rows and columns + LOOP_ROWS: DO ROW = 1, MY_NROWS + LOOP_COLS: DO COL = 1, MY_NCOLS + + PHOT_COL = COL + PECOL_OFFSET + PHOT_ROW = ROW + PEROW_OFFSET + + COSZEN = COSINE_ZENITH( COL,ROW ) ! local cosine of solar zenith angle + + IF ( COSZEN .LE. 0.0 ) THEN +!...the cell is dark: set variables to zero and cycle + RJ( COL,ROW, :,: ) = 0.0 + + IF ( JTIME_CHK ) THEN + TOTAL_OC( COL,ROW ) = 0.0 + TROPO_OC( COL,ROW ) = 0.0 + ETOT_SFC_WL ( COL,ROW, : ) = 0.0 + TAUO3_TOP_WL( COL,ROW, : ) = 0.0 + TAU_AERO_WL ( COL,ROW, : ) = 0.0 + TAU_CLOUD_WL( COL,ROW, : ) = 0.0 +#ifdef phot_debug + SSA_CLOUD_WL( COL,ROW, : ) = 0.0 + ASY_CLOUD_WL( COL,ROW, : ) = 0.0 +#endif + TAU_TOT_WL( COL,ROW, : ) = 0.0 + TAU ( COL,ROW, :,: ) = 0.0 + TAU_AERO ( COL,ROW, :,: ) = 0.0 + AERO_SSA ( COL,ROW, :,: ) = 0.0 + AERO_ASYM ( COL,ROW, :,: ) = 0.0 + ACTINIC_FX( COL,ROW, :,: ) = 0.0 + +! TROPO_O3_EXCEED( COL,ROW ) = 0.0 + TRANSMIS_DIFFUSE( COL,ROW ) = 0.0 + TRANSMIS_DIRECT ( COL,ROW ) = 0.0 + REFLECT_COEFF ( COL,ROW ) = 0.0 + CLR_TRANSMISSION( COL,ROW ) = 0.0 + CLR_TRANS_DIRECT( COL,ROW ) = 0.0 + CLR_REFLECTION ( COL,ROW ) = 0.0 + END IF + + CYCLE LOOP_COLS + + END IF + +!...initialize BLKRJ using F90 array operations. + + BLKRJ_RES = 0.0 + BLKRJ_ACM = 0.0 + +!...Set height of lowest level to zero + + BLKZF( 1 ) = 0.0 + + ZSFC = HT( COL,ROW ) ! surface height [m] + SINZEN = SQRT( 1.0 - COSZEN * COSZEN ) ! sine of zenith angle + +!...local latitude and longitude + +! LATCR = LAT( COL,ROW ) +! LONCR = LON( COL,ROW ) + +!...get total ozone column based on OMI observations + CALL O3TOTCOL ( LAT( COL,ROW ), LON( COL,ROW ), JDATE, TOTAL_O3_COLUMN ) + + IF ( USE_ACM_CLOUD .OR. CLDATT ) THEN + OWATER_FRAC = MAX( ( 1.0 - SEAICE( COL,ROW ) ), 0.0 ) + & * WATER_FRACTION( COL,ROW ) + SEAICE_FRAC = SEAICE( COL,ROW ) * WATER_FRACTION( COL,ROW ) + SNOW_FRAC = SNOCOV( COL,ROW ) + COL_CLOUD = PHOT_COL + ROW_CLOUD = PHOT_ROW + END IF + +!...loop over vertical layers ambient air conditions and gas concentration + DO L = 1, NLAYS +!...Fetch the grid cell ambient data at each layer. + + BLKTA ( L ) = TA ( COL,ROW,L ) ! temperature [K] + BLKPRS ( L ) = PRES ( COL,ROW,L ) / STDATMPA ! [atmospheres] + BLKDENS( L ) = DENS ( COL,ROW,L ) * DENS_CONV ! [molecules / cm**3] + BLKZH ( L ) = ZM ( COL,ROW,L ) ! mid layer height [m] + BLKZF ( L+1 ) = ZFULL( COL,ROW,L ) ! full layer height [m] + +!...set scale factor for [ppm] -> [molecule / cm**3] +!... To go from ppm to molecule/cc: +!... molecule/cc = ppm * 1.0E-06 * DENS (given in molecule/cc) + + MSCALE = BLKDENS( L ) * PPM_MCM3 + +!...fetch ozone and no2 and convert to [ molecules / cm **3 ] +!... and adjust the volume for ambient temperature and pressure. + + BLKO3 ( L ) = CGRID( COL,ROW,L,LGC_O3 ) * MSCALE + BLKNO2( L ) = CGRID( COL,ROW,L,LGC_NO2 ) * MSCALE + ZLEV = BLKZF( L ) + END DO ! loop on layers ambient conditions and gases + + IF ( CLDATT .AND. CFRAC_2D( COL,ROW ) .GT. 0.0 ) THEN + DO L = 1, NLAYS + + IF ( CFRAC_3D( COL,ROW,L ) .GT. 0.0 ) THEN + CLOUDS ( L ) = .TRUE. + CLOUD_LAYERING( L ) = .TRUE. + CLDFRAC( L ) = CFRAC_3D( COL,ROW,L ) +!... set hydrometeor concentrations for resolved cloud + MSCALE = 1.0E+3 * DENS ( COL,ROW,L ) + IWC( L ) = MSCALE * QI( COL,ROW,L ) + GWC( L ) = MSCALE * QG( COL,ROW,L ) + SWC( L ) = MSCALE * QS( COL,ROW,L ) + LWC( L ) = MSCALE * QC( COL,ROW,L ) + RWC( L ) = MSCALE * QR( COL,ROW,L ) + ELSE + CLOUDS ( L ) = .FALSE. + CLOUD_LAYERING( L ) = .FALSE. + CLDFRAC( L ) = 0.0 + IWC( L ) = 0.0 + GWC( L ) = 0.0 + SWC( L ) = 0.0 + LWC( L ) = 0.0 + RWC( L ) = 0.0 + END IF + END DO ! loop on layers clouds +! get optical properties of resolved cloud hydrometeors + CALL GET_DROPLET_OPTICS( NLAYS, BLKTA, OWATER_FRAC, SEAICE_FRAC, SNOW_FRAC, LWC ) + CALL GET_ICE_OPTICS( NLAYS, BLKTA, IWC ) + CALL GET_AGGREGATE_OPTICS( NLAYS, RWC, SWC, GWC ) + ELSE + CLOUDS = .FALSE. + CLOUD_LAYERING = .FALSE. + CLDFRAC = 0.0 +! hydrometeor concentrations + LWC = 0.0 + IWC = 0.0 + RWC = 0.0 + SWC = 0.0 + RWC = 0.0 + CALL CLEAR_HYDROMETEOR_OPTICS() + END IF + +!..calculate needed aerosol properties in column + +! IF ( CORE_SHELL ) THEN + CALL GET_AERO_DATA ( COL,ROW, NLAYS, CGRID ) +! ELSE +! CALL AERO_OPTICS_INTERNAL( COL,ROW, NLAYS, CGRID ) +! END IF + +! set surface albedo + + FORALL ( IWL = 1:NWL ) + ALB( IWL ) = SURFACE_ALBEDO( IWL, COL,ROW ) + END FORALL +!set min/max fractions of ozone column in stratosphere and troposphere +! MIN_STRATO3_FRAC = MIN_STRAT_03_FRAC( COL, ROW ) +! MAX_TROPOO3_FRAC = MAX( 1.0 - MIN_STRAT_03_FRAC( COL, ROW ), 0.0 ) +! MIN_STRATO3_FRAC = MONTH_STRAT_03_FRAC( COL, ROW ) +! MAX_TROPOO3_FRAC = MAX( 1.0 - MONTH_STRAT_03_FRAC( COL, ROW ), 0.0 ) +!...calculate resolved-sky photolysis rates at all layers: + + NEW_PROFILE = .TRUE. + ONLY_SOLVE_RAD = .FALSE. + + CALL NEW_OPTICS ( JDATE, JTIME, NLAYS, + & BLKTA, BLKPRS, BLKDENS, BLKZH, BLKZF, + & BLKO3, BLKNO2, + & ZSFC, COSZEN, SINZEN, RSQD, + & NEW_PROFILE, CLOUDS, CLDFRAC, + & BLKRJ_RES, TAUC_AERO, TAU_TOT, TAUO3_TOP, + & TAU_RAY, SSA, TAU_CLOUD, TOTAL_O3_COLUMN ) + +!...load diagnostic file arrays + IF ( PHOTDIAG .AND. .NOT. STRATO3_MINS_MET ) THEN + N_EXCEED_TROPO3( COL,ROW ) = N_EXCEED_TROPO3( COL,ROW ) + 1.0 + TROPO_O3_EXCEED( COL,ROW ) = TROPO_O3_COLUMN/(MAX_TROPOO3_FRAC*TOTAL_O3_COLUMN) - 1.0 +! & + 1.0 / TROPO_O3_TOGGLE - 1.0 + & + TROPO_O3_EXCEED( COL,ROW ) +! ELSE IF( PHOTDIAG ) THEN +! TROPO_O3_EXCEED( COL,ROW ) = 0.0 + END IF + + IF ( JTIME_CHK ) THEN + TOTAL_OC( COL,ROW ) = REAL( TOTAL_O3_COLUMN ) + TROPO_OC( COL,ROW ) = REAL( TROPO_O3_COLUMN ) + TRANSMIS_DIFFUSE( COL,ROW ) = TRANSMISSION + TRANSMIS_DIRECT( COL,ROW ) = TRANS_DIRECT + REFLECT_COEFF( COL,ROW ) = REFLECTION + + + FORALL( IWL = 1:NWL ) + ETOT_SFC_WL ( COL,ROW,IWL ) = IRRADIANCE( 1,IWL ) + TAUO3_TOP_WL( COL,ROW,IWL ) = TAUO3_TOP( IWL ) + TAU_AERO_WL ( COL,ROW,IWL ) = TAUC_AERO( 1,IWL ) + TAU_TOT_WL ( COL,ROW,IWL ) = TAU_TOT ( 1,IWL ) + TAU_CLOUD_WL( COL,ROW,IWL ) = TAU_CLOUD( 1,IWL ) +#ifdef phot_debug + SSA_CLOUD_WL( COL,ROW,IWL ) = AVE_SSA_CLD ( IWL ) + ASY_CLOUD_WL( COL,ROW,IWL ) = AVE_ASYMM_CLD( IWL ) +#endif + END FORALL + FORALL ( LEV = 1:NLAYS, IWL = 1:NWL ) + ACTINIC_FX( COL,ROW,LEV,IWL ) = ACTINIC_FLUX( LEV,IWL ) + END FORALL + + DO L = 1, N_DIAG_WVL + IWL = DIAG_WVL( L ) + FORALL ( LEV = 1:NLAYS ) + TAU ( COL,ROW,LEV,L ) = TAU_TOT ( LEV,IWL ) + TAU_AERO( COL,ROW,LEV,L ) = TAUC_AERO( LEV,IWL ) + END FORALL + FORALL ( LEV = 1:NLAYS, AERO_EXTI_COEF( LEV,IWL ) .GT. EPSLON ) + AERO_SSA ( COL,ROW,LEV,L ) = AERO_SCAT_COEF( LEV,IWL ) + & / AERO_EXTI_COEF( LEV,IWL ) + AERO_ASYM( COL,ROW,LEV,L ) = AERO_ASYM_FAC( LEV,IWL ) + END FORALL + FORALL ( LEV = 1:NLAYS, AERO_EXTI_COEF( LEV,IWL ) .LE. EPSLON ) + AERO_SSA ( COL,ROW,LEV,L ) = 1.0 + AERO_ASYM( COL,ROW,LEV,L ) = 0.0 + END FORALL + END DO + END IF + +!Set Photolysis rates to resolved sky values + FORALL ( L = 1:NLAYS, IPHOT = 1:NPHOTAB ) + RJ( COL,ROW, L,IPHOT ) = 60.0 * BLKRJ_RES( L,IPHOT ) + END FORALL ! Loop on layers and NPHOTAB + + IF ( USE_ACM_CLOUD ) THEN + IF ( ACM_CLOUDS( COL,ROW ) .GT. 0.0 ) THEN +! save resolved sky reflection and transmission coefficients for possible latter use + RES_SKY_REFLECT = REFLECTION + RES_SKY_TRANS = TRANSMISSION + RES_SKY_TRANSD = TRANS_DIRECT +!...find the highest layer of the sub-grid (convective) cloud + DO LEV = NLAYS, 1, -1 + IF ( ACM_CFRAC( LEV, COL,ROW ) .GT. 0.0 ) EXIT + END DO +!...replace the lower layers with sub-grid cloud properties + DO L = 1, LEV + SWC( L ) = 0.0 + IF ( ACM_CFRAC( L,COL,ROW ) .GT. 0.0 ) THEN + CLOUDS ( L ) = .TRUE. + CLDFRAC( L ) = 1.0 + MSCALE = 1.0E+3 * DENS ( COL,ROW, L ) + LWC( L ) = MSCALE * ACM_QC( L,COL,ROW ) + IWC( L ) = MSCALE * ACM_QI( L,COL,ROW ) + RWC( L ) = MSCALE * ACM_QR( L,COL,ROW ) + GWC( L ) = MSCALE * ACM_QG( L,COL,ROW ) + ELSE + CLOUDS( L ) = .FALSE. + CLDFRAC( L ) = 0.0 + LWC( L ) = 0.0 + IWC( L ) = 0.0 + RWC( L ) = 0.0 + GWC( L ) = 0.0 + END IF + CLOUD_LAYERING( L ) = .FALSE. + END DO +! write(logdev,*)'ACM cloud present fraction, cloud lwc(lev),iwc(lev),rwc(1),gwc(1) = ', +! & ACM_CLOUDS( COL,ROW ),lwc(lev),iwc(lev),rwc(1),gwc(1) + +! get optical properties of of subgrid cloud hydrometeors + CALL GET_DROPLET_OPTICS( LEV, BLKTA, OWATER_FRAC, SEAICE_FRAC, SNOW_FRAC, LWC ) + CALL GET_ICE_OPTICS( LEV, BLKTA, IWC ) + CALL GET_AGGREGATE_OPTICS( LEV, RWC, SWC, GWC ) + +!...calculate the acm-cloud photolysis rates for all layers: + NEW_PROFILE = .FALSE. + CALL NEW_OPTICS ( JDATE, JTIME, NLAYS, + & BLKTA, BLKPRS, BLKDENS, BLKZH, BLKZF, + & BLKO3, BLKNO2, + & ZSFC, COSZEN, SINZEN, RSQD, + & NEW_PROFILE, CLOUDS, CLDFRAC, + & BLKRJ_ACM, TAUC_AERO, TAU_TOT, TAUO3_TOP, + & TAU_RAY, SSA, TAU_CLOUD, TOTAL_O3_COLUMN ) + +!...load diagnostic file arrays +!...compute a cloud-fraction weighted average of ETOT_SFC and TAU_TOT +!... note that both TAUC_AERO and TAUO3_TOP are the same for clear and +!... cloudy regions + MSCALE = MAX( 1.0 - ACM_CLOUDS( COL,ROW ), 0.0 ) + + IF ( JTIME_CHK ) THEN + + TRANSMIS_DIRECT( COL,ROW ) = MSCALE * TRANSMIS_DIRECT( COL,ROW ) + & + ACM_CLOUDS( COL,ROW ) * TRANS_DIRECT + TRANSMIS_DIFFUSE( COL,ROW ) = MSCALE * TRANSMIS_DIFFUSE( COL,ROW ) + & + ACM_CLOUDS( COL,ROW ) * TRANSMISSION + REFLECT_COEFF( COL,ROW ) = MSCALE * REFLECT_COEFF( COL,ROW ) + & + ACM_CLOUDS( COL,ROW ) * REFLECTION + FORALL ( IWL = 1:NWL ) + ETOT_SFC_WL ( COL,ROW,IWL ) = MSCALE * ETOT_SFC_WL( COL,ROW,IWL ) + & + ACM_CLOUDS( COL,ROW ) * IRRADIANCE( 1,IWL ) + TAU_TOT_WL ( COL,ROW,IWL ) = MSCALE * TAU_TOT_WL( COL,ROW,IWL ) + & + ACM_CLOUDS( COL,ROW ) * TAU_TOT( 1,IWL ) + TAU_CLOUD_WL( COL,ROW,IWL ) = MSCALE * TAU_CLOUD_WL( COL,ROW,IWL ) + & + ACM_CLOUDS( COL,ROW ) * TAU_CLOUD( 1,IWL ) +#ifdef phot_debug + SSA_CLOUD_WL( COL,ROW,IWL ) = MSCALE * SSA_CLOUD_WL( COL,ROW,IWL ) + & + ACM_CLOUDS( COL,ROW ) * AVE_SSA_CLD ( IWL ) + ASY_CLOUD_WL( COL,ROW,IWL ) = MSCALE * ASY_CLOUD_WL( COL,ROW,IWL ) + & + ACM_CLOUDS( COL,ROW ) * AVE_ASYMM_CLD( IWL ) +#endif + END FORALL ! iwl + FORALL ( LEV = 1:NLAYS, IWL = 1:NWL ) + ACTINIC_FX( COL,ROW,LEV,IWL ) = MSCALE * ACTINIC_FX( COL,ROW,LEV,IWL ) + & + ACM_CLOUDS( COL,ROW ) * ACTINIC_FLUX( LEV,IWL ) + END FORALL ! lev and iwl + + DO L = 1, N_DIAG_WVL + IWL = DIAG_WVL( L ) + FORALL ( LEV = 1:NLAYS) + TAU( COL,ROW,LEV,L ) = MSCALE * TAU( COL,ROW,LEV,L ) + & + ACM_CLOUDS( COL,ROW ) * TAU_TOT( LEV,IWL ) + END FORALL + END DO + END IF ! photdiag +!Photolysis rates become a weighted average of the values from resolved and ACM skies + FORALL ( L = 1:NLAYS, IPHOT = 1:NPHOTAB ) + RJ( COL,ROW, L, IPHOT ) = 60.0 * ACM_CLOUDS( COL,ROW ) * BLKRJ_ACM( L,IPHOT ) + & + MSCALE * RJ( COL,ROW,L,IPHOT ) + END FORALL ! Loop on layers and PHOT + END IF + END IF ! not USE_ACM_CLOUD and ACM_CLOUDS > 0 + + IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients + IF ( ANY( CLOUDS ) ) THEN + IF ( CFRAC_2D( COL,ROW ) .GT. 0.0 ) THEN ! resolved and subgrid clouds exist + CLOUDS = .FALSE. + NEW_PROFILE = .FALSE. + ONLY_SOLVE_RAD = .TRUE. + CALL NEW_OPTICS ( JDATE, JTIME, NLAYS, + & BLKTA, BLKPRS, BLKDENS, BLKZH, BLKZF, + & BLKO3, BLKNO2, + & ZSFC, COSZEN, SINZEN, RSQD, + & NEW_PROFILE, CLOUDS, CLDFRAC, + & BLKRJ_RES, TAUC_AERO, TAU_TOT, TAUO3_TOP, + & TAU_RAY, SSA, TAU_CLOUD, TOTAL_O3_COLUMN) + CLR_REFLECTION ( COL,ROW ) = REFLECTION + CLR_TRANSMISSION( COL,ROW ) = TRANSMISSION + CLR_TRANS_DIRECT( COL,ROW ) = TRANS_DIRECT + ELSE ! only subgrid clouds exist + CLR_REFLECTION ( COL,ROW ) = RES_SKY_REFLECT + CLR_TRANSMISSION( COL,ROW ) = RES_SKY_TRANS + CLR_TRANS_DIRECT( COL,ROW ) = RES_SKY_TRANSD + END IF + ELSE ! no cloud in vertical column + CLR_REFLECTION ( COL,ROW ) = REFLECTION + CLR_TRANSMISSION( COL,ROW ) = TRANSMISSION + CLR_TRANS_DIRECT( COL,ROW ) = TRANS_DIRECT + END IF + END IF + + END DO LOOP_COLS + END DO LOOP_ROWS + + END IF + +!...report on whether stratospheric ozone column satisfies climatological minimums + IF( N_TROPO_O3_TOGGLE .GT. 0 )THEN + O3_TOGGLE_AVE = O3_TOGGLE_AVE / REAL( N_TROPO_O3_TOGGLE ) + WRITE( LOGDEV, 9500 )'PHOT: Exceedance of tropospheric ozone column ', + & 'or below top of model domains based on stratospheric column minimum ', + & 'at date and time; ', JDATE, JTIME, N_TROPO_O3_TOGGLE, (1.0/O3_TOGGLE_AVE - 1.0), + & (1.0/O3_TOGGLE_MIN - 1.0) + END IF + +!...write diagnostic data to output file at the end of every output tstep + + IF ( JTIME_CHK ) THEN + + VARNM = 'COSZENS' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, + & COSINE_ZENITH ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'OZONE_COLUMN' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, TOTAL_OC ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TROPO_O3_COLUMN' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, TROPO_OC ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + IMONTH = IMONTH + 1 + IF( IMONTH .GT. 12 )THEN + IMONTH = 1 + TDATE = 2011001 + END IF + TDATE = TDATE + DAYS( IMONTH ) +! CALL SEASONAL_STRAT_O3(TDATE, JTIME ) + + +! VARNM = 'MIN_FRAC_STRATO3' +! IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, MONTH_STRAT_03_FRAC ) ) THEN +! XMSG = 'Error writing variable ' // VARNM +! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) +! END IF + + + VARNM = 'TRANS_DIFFUSE' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, TRANSMIS_DIFFUSE ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TRANS_DIRECT' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, TRANSMIS_DIRECT ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'REFLECTION' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, REFLECT_COEFF ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'CLR_TRANS_DIF' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, CLR_TRANSMISSION ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'CLR_TRANS_DIR' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, CLR_TRANS_DIRECT ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'CLR_REFLECTION' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, CLR_REFLECTION ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TROPO_O3_EXCEED' + TROPO_O3_EXCEED = TROPO_O3_EXCEED / REAL( MAX(1, TSTEP_COUNT) ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, TROPO_O3_EXCEED ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + TROPO_O3_EXCEED = 0.0 ! reset sum and counter + TSTEP_COUNT = 0 + + VARNM = 'N_EXCEED_TROPO3' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, N_EXCEED_TROPO3 ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + N_EXCEED_TROPO3 = 0.0 ! reset counter + + VARNM = 'JNO2' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, RJ( :,:,1, LNO2 ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'JO3O1D' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, RJ( :,:,1,LO3O1D ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'RESOLVED_CFRAC' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, CFRAC_2D ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'RESOLVED_WBAR' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, AVE_HYDROMETEORS ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + IF ( USE_ACM_CLOUD ) THEN + VARNM = 'SUBGRID_CFRAC' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, ACM_CLOUDS ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + VARNM = 'SUBGRID_WBAR' + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, ACM_AVE_H2O ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END IF + + DO IWL = 1, NWL + + VARNM = 'ETOT_SFC_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, ETOT_SFC_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, ODATE, OTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TAU_AERO_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, TAU_AERO_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TAU_CLOUD_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, TAU_CLOUD_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +#ifdef phot_debug + VARNM = 'SSA_CLOUD_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, SSA_CLOUD_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'ASY_CLOUD_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, ASY_CLOUD_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF +#endif + + VARNM = 'TAU_TOT_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, TAU_TOT_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TAUO3_TOP_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, + & OTIME, TAUO3_TOP_WL( :,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'ALBEDO_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_1, VARNM, ODATE, OTIME, + & SURFACE_ALBEDO( IWL,:,: ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + END DO ! iwl + + WRITE( LOGDEV, '( /5X, 3( A, :, 1X ), I8, ":", I6.6 )' ) + & 'RJ Values written to', CTM_RJ_1, + & 'for date and time', ODATE, OTIME + + DO IPHOT = 1, NPHOTAB + IF ( .NOT. WRITE3( CTM_RJ_2, PHOTAB( IPHOT ), ODATE, + & OTIME, RJ( :,:,:,IPHOT ) ) ) THEN + XMSG = 'Could not write ' // CTM_RJ_2 // ' file' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + + VARNM = 'CFRAC_3D' + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, CFRAC_3D ) ) THEN + XMSG = 'Could not write ' // TRIM( VARNM ) // ' to ' // CTM_RJ_2 // ' file' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + DO IWL = 1, NWL + VARNM = 'ACTINIC_FX_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, ACTINIC_FX( :,:,:,IWL ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + + DO L = 1, N_DIAG_WVL + IWL = DIAG_WVL( L ) + + VARNM = 'AERO_SSA_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, AERO_SSA( :,:,:,L ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'AERO_ASYM_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, AERO_ASYM( :,:,:,L ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TAU_AERO_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, TAU_AERO( :,:,:,L ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VARNM = 'TAU_W' // WLTXT( IWL ) + IF ( .NOT. WRITE3( CTM_RJ_2, VARNM, ODATE, OTIME, TAU( :,:,:,L ) ) ) THEN + XMSG = 'Error writing variable ' // VARNM + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + + WRITE( LOGDEV, '( /5X, 3( A, :, 1X ), I8, ":", I6.6 )' ) + & 'RJ and Optical Data written to', CTM_RJ_2, + & 'for date and time', ODATE, OTIME + + END IF ! if JTIME_CHK + +1003 FORMAT( 8X, 'Processor ',I4.4,' is in darkness at ', I8.7, ':', I6.6, + & 1X, 'GMT - no photolysis') +9500 FORMAT(3(/ A), I7, 1X, I6.6, 1X, / "Total Number: ", I9, ";Mean Value: ", F9.6, + & "; Max Value: ",F9.6 /) + + RETURN + END SUBROUTINE PHOT From 539e975a43f43c4bc9cb7c1103d16beb32f5dc12 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Fri, 11 Feb 2022 21:35:32 +0000 Subject: [PATCH 03/72] Initial modifications to canopy photolysis CMAQ5.2.1 codes. --- src/model/src/ASX_DATA_MOD.F | 100 ++ src/model/src/PHOT_MOD.F | 1898 ---------------------------------- src/model/src/phot.F | 155 ++- 3 files changed, 254 insertions(+), 1899 deletions(-) delete mode 100644 src/model/src/PHOT_MOD.F diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 8cad21f..197be5f 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -120,6 +120,18 @@ Module ASX_DATA_MOD Logical, Allocatable :: CONVCT ( :,: ) ! convection flag Real, Allocatable :: PBL ( :,: ) ! pbl height (m) Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) +!> Inline Canopy Processes + Real, Allocatable :: FCH ( :,: ) ! Forest Canopy Height (m) + Real, Allocatable :: FRT ( :,: ) ! Forest Fraction + Real, Allocatable :: CLU ( :,: ) ! Clumping Index + Real, Allocatable :: POPU ( :,: ) ! Population Density (people/10km2) + Real, Allocatable :: LAIE ( :,: ) ! ECCC BELD3 Derived LAI (m2/m2) + Real, Allocatable :: C1R ( :,: ) ! cumulative LAI fraction hc to 0.75 * hc + Real, Allocatable :: C2R ( :,: ) ! cumulative LAI fraction hc to 0.50 * hc + Real, Allocatable :: C3R ( :,: ) ! cumulative LAI fraction hc to 0.35 * hc + Real, Allocatable :: C4R ( :,: ) ! cumulative LAI fraction hc to 0.20 * hc + + !> U and V wind components on the cross grid points Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] @@ -551,6 +563,21 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) Grid_Data%WRES = 0.0 Grid_Data%BSLP = 0.0 + ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), + & Met_Data%FRT ( NCOLS,NROWS ), + & Met_Data%CLU ( NCOLS,NROWS ), + & Met_Data%POPU ( NCOLS,NROWS ), + & Met_Data%LAIE ( NCOLS,NROWS ), + & Met_Data%C1R ( NCOLS,NROWS ), + & Met_Data%C2R ( NCOLS,NROWS ), + & Met_Data%C3R ( NCOLS,NROWS ), + & Met_Data%C4R ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Canopy Shade variables' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), @@ -1026,6 +1053,79 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If +C Canopy vars + VNAME = 'FCH' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%FCH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'FRT' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%FRT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'CLU' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%CLU ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'POPU' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%POPU ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LAIE' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%LAIE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'C1R' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%C1R ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'C2R' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%C2R ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'C3R' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%C3R ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'C4R' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2,STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%C4R ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + C Soil vars VNAME = 'SOIM1' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, diff --git a/src/model/src/PHOT_MOD.F b/src/model/src/PHOT_MOD.F deleted file mode 100644 index 7d93dec..0000000 --- a/src/model/src/PHOT_MOD.F +++ /dev/null @@ -1,1898 +0,0 @@ - -!------------------------------------------------------------------------! -! The Community Multiscale Air Quality (CMAQ) system software is in ! -! continuous development by various groups and is based on information ! -! from these groups: Federal Government employees, contractors working ! -! within a United States Government contract, and non-Federal sources ! -! including research institutions. These groups give the Government ! -! permission to use, prepare derivative works of, and distribute copies ! -! of their work in the CMAQ system to the public and to permit others ! -! to do so. The United States Environmental Protection Agency ! -! therefore grants similar permission to use the CMAQ system software, ! -! but users are requested to provide copies of derivative works or ! -! products designed to operate in the CMAQ system to the United States ! -! Government without restrictions as to use by others. Software ! -! that is used with the CMAQ system but distributed under the GNU ! -! General Public License or the GNU Lesser General Public License is ! -! subject to their copyright restrictions. ! -!------------------------------------------------------------------------! - -C $Header$ - -C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - MODULE PHOT_MOD - -C----------------------------------------------------------------------- -C -C FSB This version has NO internal write statements -C FSB This version has the code for XR96 added. -C FSB change indices from L to II in newOptics loop 08/17/2006 -C FSB This version has all write statements commented out.(08/03/2006) -C -C FSB NOTE - this code assumes that the top of the modeling domain -C is about 100 [mb] or 10 [kPa] ~ 16 [km] in altitude. If a -C higher altitude top is used , the method of calculating the -C ozone column and the ozone optical depth will be necessary. -C -C FSB This version has the addition of Rayleigh optical depth for the -C stratosphere as well as the calculation of single scattering -C albedo for the AOD calculation. (01/17/2006) -C FSB This version has deleted the JPROC values of Cs and Qy as well as -C the default aerosol. It also contains the fast optics -C routines. -C FSB This module supports the SAPRC99 Chemical mechanism within -C CMAQ. -C FSB This version calls a fast optical routine for aerosol -C extinction and scattering -C FSB This version uses a set of constant refractive indices -C The new subroutine GETNEWPAR now sets up the refractive indices. -C -C Bill Hutzell(Mar 2011) moved determining refractive indices to a -C separate file and new subroutine called AERO_PHOTDATA. -C -C Bill Hutzell(Jun 2011) modified TWOSTREAM_S subroutine to account for -C GAM2 equal to zero in the Toon et al. (1989) solution to the two stream -C of the radiative transfer equation based on how the NCAR TUV model -C implements the approximation -C -C Bill Hutzell(May 2013) modified optical depth agruments to give vetical -C profile rather than surface values. Note that TAU_TOT now includes -C stratospheric values. -! Bill Hutzell(Mar 2014) modified calculation of aerosol and cloud optical -! properites as well as their calculated optical depths. The changes employ -! FORTRAN modules that contain the layer level of the optical properties. -C 07 Jul 14 B.Hutzell: replaced mechanism include file(s) with fortran module -C 10/10/14 - DJL added references to IUPAC10 to NO2 and O3 photo rates -C 23Jun15 B.Hutzell: made TWOSTREAM and TRIDIAGONAL routine use REAL(8) variables -C 30Jul15 J.Young: REAL(4) -> REAL for code portability -C----------------------------------------------------------------------- - - USE CSQY_DATA - - IMPLICIT NONE - -!***include files - - INCLUDE SUBST_CONST ! physical constants - -!***parameters - - REAL, PARAMETER :: SMALL = 1.0E-36 ! a small number - -!***Fundamental Constants: ( Source: CRC76, pp 1-1 to 1-6) - - REAL, PARAMETER :: PLANCK_C = 6.62606876E-34 ! Planck's Constant [Js] - REAL, PARAMETER :: LIGHT_SPEED = 299792458.0 ! speed of light in a vacuum - - REAL, PARAMETER :: DU_TO_CONC = 2.6879E16 ! factor from [DU] to [molecules/cm^2] - REAL, PARAMETER :: CONC_TO_DU = 1.0 / DU_TO_CONC - - LOGICAL, PARAMETER :: ADJUST_OZONE = .FALSE. ! Flag to correct tropospheric ozone optical depth based - ! on climatology - - REAL :: MIN_STRATO3_FRAC ! minimum fraction of O3 column in statosphere - REAL :: MAX_TROPOO3_FRAC ! maximum fraction of O3 column in troposphere - -! REAL, PARAMETER :: MIN_STRATO3_FRAC = 0.55 ! minimum fraction of O3 column in statosphere - ! if PTOP = 50 mb -! REAL, PARAMETER :: MAX_TROPOO3_FRAC = 1.0 - MIN_STRATO3_FRAC ! maximum fraction of O3 column in troposphere - -!***LOGDEV for NEW_OPTICS and supporting routines - - INTEGER, SAVE :: NEW_OPTICS_LOG - - INTEGER, PARAMETER :: N_DIAG_WVL = 2 ! number of dianostic wavelengths - INTEGER, SAVE :: DIAG_WVL( N_DIAG_WVL ) ! pointers to diagnostic wavelengths - INTEGER :: N_TROPO_O3_TOGGLE ! number of adjustments to ozone extinction - - REAL, ALLOCATABLE :: ACTINIC_FLUX( :,: ) ! actinic fluxes, initially [Photons/(cm^2s)] then [Watts/m^2] - REAL, ALLOCATABLE :: IRRADIANCE ( :,: ) ! total downward irradiance [Watts/m^2] - REAL :: REFLECTION ! broad band reflection coefficient (diffuse) at model top - REAL :: TRANSMISSION ! broad band transmission coefficient (diffuse) at surface - REAL :: TRANS_DIRECT ! broad band direct transmission coefficient at surface - REAL :: TROPO_O3_COLUMN ! ozone column density in the troposphere [Dobson Units] - REAL :: TROPO_O3_TOGGLE ! factor correcting tropospheric ozone column - REAL :: O3_TOGGLE_AVE ! average of nonunity factors adjusting ozone extinction - REAL :: O3_TOGGLE_MIN ! Max of nonunity factors adjusting ozone extinction - - LOGICAL :: ONLY_SOLVE_RAD ! only compute fluxes - LOGICAL :: OBEY_STRATO3_MINS = .TRUE. ! Has stratospheric O3 column not violated - ! climatological minimums, yet? - LOGICAL :: STRATO3_MINS_MET ! Does the call to NEW_OPTICS meet the stratospheric O3 column - ! climatological minimums? - - - CHARACTER( 133 ) :: PHOT_MOD_MSG - - INTEGER :: PHOT_COL ! cell column of routine calling module routine - INTEGER :: PHOT_ROW ! cell row of routine calling module routine - - - CONTAINS - -C/////////////////////////////////////////////////////////////////////// - SUBROUTINE NEW_OPTICS ( JDATE, JTIME, NLAYS, - & BLKTA, BLKPRS, BLKDENS, BLKZH, BLKZF, - & BLKO3, BLKNO2, - & ZSFC, COSZEN, SINZEN, RSQD, - & NEW_PROFILE, CLOUDS, CLDFRC, - & BLKRJ, TAUC_AERO, TAU_TOT, TAUO3_TOP, - & TAU_RAY, SSA_AERO, TAU_CLOUD, TOTAL_O3_COLUMN ) -C----------------------------------------------------------------------- -C -C FSB NOTE new call vector <<<<<<<<<<<<< ********** -C -C FSB This version has clouds -C FSB calculates the photolysis rates as a function of species and height -C -C first coded 10/19/2004 by Dr. Francis S. Binkowski -C Carolina Environmental Program -C University of North Carolina at Chapel Hill -C email: frank_binkowski@unc.edu -C modified by FSB July 29, 2005, 01/19/2006 by FSB -C -C Mar 2011 Bill Hutzell -C -revised arguement to account for aerosol redesign in -C CMAQ version 5.0 -C -change array declaration to allow flexible number of -C wavelength bins -C Apr 2012 Bill Hutzell -C -revised error checking to needed photolysis data -C -modified case statement for RACM2 photolysis rates -C -moved aerosol optics to its own module -C 07 Jul 14 B.Hutzell: replaced mechanism include file(s) with fortran module -C----------------------------------------------------------------------- - - USE UTILIO_DEFN - USE RXNS_DATA ! chemical mechanism data - USE CLOUD_OPTICS ! data and routines for optics of cloud hydrometeors - - USE AERO_PHOTDATA - - IMPLICIT NONE - -!***arguments - INTEGER, INTENT(IN) :: JDATE ! julian date YYYYDDD - INTEGER, INTENT(IN) :: JTIME ! TIME HHMMSS - INTEGER, INTENT(IN) :: NLAYS ! # of vertical layers - - REAL, INTENT(IN) :: BLKPRS ( : ) ! Air pressure in [ atm ] - REAL, INTENT(IN) :: BLKTA ( : ) ! Air temperature [ K ] - REAL, INTENT(IN) :: BLKDENS( : ) ! Air density [ molecules / cm**3 ] - REAL, INTENT(IN) :: BLKZH ( : ) ! layer half-height [ m ] - REAL, INTENT(IN) :: BLKZF ( : ) ! layer full height[ m ] - REAL, INTENT(IN) :: BLKO3 ( : ) ! O3 concentration [ molecules / cm**3 ] - REAL, INTENT(IN) :: BLKNO2 ( : ) ! NO2 concentration [ molecules / cm**3 ] - REAL, INTENT(IN) :: ZSFC ! surface height (msl) [ m ] - REAL, INTENT(IN) :: COSZEN, SINZEN ! sine and cosine of the zenith angle - REAL, INTENT(IN) :: RSQD ! square of solar distance [ au**2 ] - - LOGICAL, INTENT(IN) :: NEW_PROFILE ! Has the atmospheric profile changed since last call? - LOGICAL, INTENT(IN) :: CLOUDS( : ) ! Does layer have clouds - REAL, INTENT(IN) :: CLDFRC( : ) ! fraction of gridcell covered by cloud - - - REAL, INTENT(OUT) :: BLKRJ( :,: ) ! photolysis rates [ 1 / sec ] - - REAL, INTENT(OUT) :: TAUC_AERO( :,: ) ! aerosol optical depth, bottom of layer - REAL, INTENT(OUT) :: TAU_TOT ( :,: ) ! total optical depth, bottom of layer - REAL, INTENT(OUT) :: TAU_CLOUD( :,: ) ! cloud optical depth, bottom of layer - - REAL, INTENT(INOUT) :: TAUO3_TOP( : ) ! optical depth of ozone above model domain - REAL, INTENT(INOUT) :: TAU_RAY ( : ) ! Rayleigh optical depth above model domain - REAL, INTENT(OUT) :: SSA_AERO ( : ) ! single scatering albedo for aerosol column - - REAL, INTENT(INOUT) :: TOTAL_O3_COLUMN ! total ozone colum density [ DU ] - -!***internal - REAL, PARAMETER :: ONE_OVER_PI = 1.0 / PI - REAL, PARAMETER :: STRAT_TEMP = 225.0 ! stratospheric temperature - REAL, PARAMETER :: ZTOA = 50.0E3 ! top of the atmosphere [ m ] - - INTEGER L, I, IWL, II, ILEV, IPHOT, MODE ! loop indices - - INTEGER NLEVEL - REAL SOLAR_FLUX ! solar flux at atmosphere top in a wavelength band, [photons/(cm^2*s)] - REAL INSOLATION ! downward solar flux at atmosphere top summed over wavelength bands, [photons/(cm^2*s)] - - REAL DELTA_O3_COLUMN ! change in ozone column density [molecules/cm2] - REAL STRAT_O3_COLUMN ! ozone column density in the stratosphere [molecules/cm2] - REAL STRAT_O3_COLMIN ! ozone minium column density in the stratosphere [molecules/cm2] - REAL TAU_O3 ! optical depth of stratospheric ozone [ m ] - REAL DENSTOM ! estimated air density at top of model [ molecules / cm**3 ] - REAL LAMDA ! wavelength [ nm ] - REAL INV_LAMBDA ! reciprocal of wavelength [ 1/nm ] - REAL LAMDA_UM ! wavelength [ um ] - -!***working absorption cross sections [ cm**2 ]. These have been corrected -!*** for ambient ( pressure and temperature ) conditions. - - REAL AO3 - REAL ANO2 - REAL BETA_M ! molecular scattering coefficient [ 1/m ] - REAL BEXT ! total aerosol extinction coefficient [ 1/m ] - REAL VFAC, BSC ! unit correction factors - REAL BSCAT ! total aerosol scattering coefficient [ 1/m ] - REAL G_BAR ! total aerosol asymmetry factor - -!***FSB The following variable is aq switch that allows a fast version of -!*** aerosol optics to be used when set to .TRUE. - -!***scattering and absorption for the layer - - REAL DTABS_A, DTABS_M, DTSCAT_A, DTSCAT_M, DTSCAT, DTABS - -!***variables describing the layer heights and slants -! REAL DJ, DF - REAL ZTOM ! top of model [ m ] - REAL, ALLOCATABLE, SAVE :: DSDH_TD( : ) ! slant path function from top down - REAL, ALLOCATABLE, SAVE :: BLKDZ( : ) ! layer thicknesses [ m ] - REAL, ALLOCATABLE, SAVE :: DSDH( : ) ! slant path function - REAL, SAVE :: DSDH_TOP ! slantpath function from ZTOM to ZTOA - -!***Increment of optical depth - - REAL, ALLOCATABLE, SAVE :: DTAU ( : ) ! total depth at level - REAL, ALLOCATABLE, SAVE :: DT_AERO ( : ) ! aerosol contribution at level - REAL, ALLOCATABLE, SAVE :: DT_CLOUD( : ) ! cloud contribution at level - -!***single scattering albedo for layer - - REAL, ALLOCATABLE, SAVE :: OM( : ) - -!***asymmetry factor - - REAL, ALLOCATABLE, SAVE :: G( : ) - -!***arrays for fluxes and irradiances used in - -!***delta-Eddington code - - REAL, ALLOCATABLE, SAVE :: FDIR( : ) ! direct actinic flux - REAL, ALLOCATABLE, SAVE :: FUP ( : ) ! diffuse upward actinic flux - REAL, ALLOCATABLE, SAVE :: FDN ( : ) ! diffuse downward flux - REAL, ALLOCATABLE, SAVE :: EDIR( : ) ! direct irradiance - REAL, ALLOCATABLE, SAVE :: EUP ( : ) ! diffuse upward irradiance - REAL, ALLOCATABLE, SAVE :: EDN ( : ) ! diffuse downward irradiance - -!***surface albedo - - REAL RSFC - - REAL FX - REAL, ALLOCATABLE, SAVE :: ESUM( : ) ! total downward irradiance - REAL, ALLOCATABLE, SAVE :: FSUM( : ) ! total actinic flux - -!***needed for stratospheric Raleigh optical depth - REAL, PARAMETER :: R_G = 100.0 * RDGAS / GRAV ! dry air gas constant - ! divided by gravitational - ! acceleration [cm/K] NOTE: cgs units - - REAL HSCALE ! Scale height [cm] ! NOTE: cgs units - - REAL NBAR ! total number of air molecules [ # /cm**2 ] - ! above top of model domain - - REAL, SAVE :: COS85 - -!***FSB Cloud properties. -!*** FSB These properties are taken fro HU & Stamnes,1993, -!*** An accurate parameterizationof the radiative properties of -!*** water clouds suitable for use in climate models, Journal of -!*** Climate, vol. 6, pp. 728-742. The values in the data statements -!*** were calculated with an equivalent radius of 10 micrometers. -!*** Note: Hu &Stamnes give beta in [ 1 / km/ for LWC in [ g / m**3 ] -!*** the values for beta/ LWC also give beta in [1/m] with LWC in [g/m **3] - - REAL G_CLOUD ! local cloud asymmetry factor - REAL OM_CLOUD ! local cloud single scattering albedo - REAL DTSCAT_CLOUD ! level increment in cloud scattering optical - REAL TAU_SCAT_CLD ! total scattering optical depth of cloud - REAL LAYERING_FACTOR ! correction factor for cloud layering - REAL STOZONE - - LOGICAL, SAVE :: FIRST = .TRUE. ! Flag for first call - LOGICAL :: SUCCESS - -!***arrays for fluxes and irradiances used in - REAL, ALLOCATABLE, SAVE :: SRAYL( : ) ! Molecular scattering cross sections [ cm ** 2] - REAL, ALLOCATABLE, SAVE :: TAU_SCAT( : ) ! aerosol scattering optical depth - REAL, ALLOCATABLE, SAVE :: CONV_WM2( : ) ! conversion factor [photons/(cm**2 s )] to [Watts/m**2] - -!***three-dimensional array for Cs and Qy -!*** (temperature, wavelength, species) -!***(layer, wavelength species) - - REAL, ALLOCATABLE, SAVE :: CSZ( :,:,: ) - REAL, ALLOCATABLE, SAVE :: QYZ( :,:,: ) - - IF ( FIRST ) THEN - - NEW_OPTICS_LOG = INIT3() - - ALLOCATE( CONV_WM2( NWL ) ) - ALLOCATE( SRAYL ( NWL ) ) - ALLOCATE( TAU_SCAT( NWL ) ) - ALLOCATE( CSZ( NLAYS,NWL,NPHOTAB ) ) - ALLOCATE( QYZ( NLAYS,NWL,NPHOTAB ) ) - - ALLOCATE( ACTINIC_FLUX( NLAYS,NWL ) ) - ALLOCATE( IRRADIANCE ( NLAYS,NWL ) ) - - ALLOCATE( DSDH_TD ( NLAYS+1 ), - & BLKDZ ( NLAYS ), - & DSDH ( NLAYS ), - & DTAU ( NLAYS+1 ), - & DT_AERO ( NLAYS+1 ), - & DT_CLOUD( NLAYS+1 ), - & OM ( NLAYS+1 ), - & G ( NLAYS+1 ), - & FDIR ( NLAYS+1 ), - & FUP ( NLAYS+1 ), - & FDN ( NLAYS+1 ), - & EDIR ( NLAYS+1 ), - & EUP ( NLAYS+1 ), - & EDN ( NLAYS+1 ), - & ESUM ( NLAYS ), - & FSUM ( NLAYS ) ) - -!***FSB Set up conversion factor for -!*** [photons / ( cm**2 s) ] to [Watts / m**2 ] -!*** THE 1.0E13 FACTO IS 1.0E9 * 1.0 E4 -!*** The 1.0e9 is for the wavelength [ nm ] -> [ m ] -!*** The 1.0e4 is for the area [ cm **2 ] -> [ m**2 ] - - DO IWL = 1, NWL - LAMDA = WAVELENGTH( IWL ) - CONV_WM2( IWL ) = 1.0E13 * ( PLANCK_C * LIGHT_SPEED ) / LAMDA - END DO - - COS85 = COS( 85.0 * PI180 ) - -!***get molecular scattering cross sections - - CALL GETSRAY ( NWL, WAVELENGTH, SRAYL ) - - FIRST = .FALSE. - - END IF ! FIRSTIME - -!***initialize BLKRJ and other layer variables - - BLKRJ = 0.0 - ACTINIC_FLUX = 0.0 - IRRADIANCE = 0.0 - REFLECTION = 0.0 - TRANSMISSION = 0.0 - TRANS_DIRECT = 0.0 - INSOLATION = 0.0 - TROPO_O3_TOGGLE = 1.0 - STRATO3_MINS_MET = .TRUE. -!***Initialize sums or set default values for outputs: -! TAUC_AERO, TAU_TOT, TAUO3_TOP, TAU_RAY, SSA_AERO, etc. - - TAUC_AERO = 0.0 - TAU_TOT = 0.0 - TAU_CLOUD = 0.0 - TAU_SCAT = 0.0 - SSA_AERO = 0.0 - TOTAL_TAU_CLD = 0.0 -#ifdef phot_debug - AVE_SSA_CLD = 0.0 - AVE_ASYMM_CLD = 0.0 -#endif -!***Test zenith angle. If coszen is zero or negative, zenith angle is -!*** equal to or greater than 90 degrees, i.e. before sunrise or -!*** after sunset at the surface. -!*** Return all photolysis rates set to zero. Ignore possible twilight -!*** processes in upper troposphere. - -!***FSB NOTE: tests of the algorithm for slant path show that the -!*** critical zenith angle for the tropospheric slant path is 88 degrees, -!*** but the critical zenith angle for the stratospheric slant path is -!*** 85 degrees. Thus, the code returns zeros for angles greater then or -!*** equalt to 85 degrees. cos( 85 degrees ) equals 8.715574e-02. - - IF ( COSZEN .LE. COS85 ) THEN - TAUO3_TOP = 0.0 - TAU_RAY = 0.0 - TOTAL_O3_COLUMN = 0.0 - TROPO_O3_COLUMN = 0.0 - TROPO_O3_TOGGLE = 1.0 - RETURN - END IF - - IF ( NEW_PROFILE ) THEN ! update based on new temperature and density profile -!***Adjust cross sections and quantum yields for ambient conditions - - CALL GET_CSQY ( BLKTA, BLKDENS, CSZ, QYZ ) - -!***calculate scale height from top of model domain - - HSCALE = R_G * BLKTA( NLAYS ) - -!***estimate air density at top of model domain - - DENSTOM = BLKDENS( NLAYS ) - & * EXP( -100.0 * ( BLKZF( NLAYS + 1 ) - BLKZH( NLAYS ) ) - & / HSCALE ) - -!***calculate the total number of air molecules [ # / cm**2 ] -!*** above top of model domain. - - NBAR = HSCALE * DENSTOM - -!***set top of modeling domain - - ZTOM = BLKZF( NLAYS + 1 ) - -!***get layer thicknesses and slantpath starting at the TOP - - CALL SLANTPATH2 ( NLAYS, BLKZF, ZSFC, REARTH, SINZEN, BLKDZ, DSDH ) - -!***get slantpath from ZTOM to ZTOA - - CALL SLANTPATHTOP ( ZTOM, ZTOA, ZSFC, REARTH, SINZEN, DSDH_TOP ) - -C*** find ozone column density for atmosphere, stratosphere, and troposphere - STRAT_O3_COLUMN = DU_TO_CONC * REAL( TOTAL_O3_COLUMN ) -! STRAT_O3_COLMIN = 0.10 * STRAT_O3_COLUMN - STRAT_O3_COLMIN = MIN_STRATO3_FRAC * STRAT_O3_COLUMN - SUCCESS = .TRUE. - TROPO_O3_COLUMN = 0.0 - DO L = NLAYS, 1, -1 - DELTA_O3_COLUMN = 100.0 * BLKO3( L ) * BLKDZ( L ) - STRAT_O3_COLUMN = STRAT_O3_COLUMN - DELTA_O3_COLUMN - TROPO_O3_COLUMN = TROPO_O3_COLUMN + DELTA_O3_COLUMN - IF ( STRAT_O3_COLUMN .LT. STRAT_O3_COLMIN .AND. SUCCESS ) THEN - IF( OBEY_STRATO3_MINS )THEN - WRITE( NEW_OPTICS_LOG,'( /A, F5.2, A, 3(/A), I3, A, F8.3, A , 2(I4,1X) )' ) - & 'PHOT WARNING: First Occurance where computed stratospheric O3 column < ', - & 100.0*MIN_STRATO3_FRAC,'%', - & 'observed total column. The percentage is a global minimum based on ', - & 'climatological ozone profiles. ', - & 'The Error accumulates downward from layer = ', L, ' or alt= ', - & 0.001*BLKZF( L ),' Km for col,row = ', PHOT_COL, PHOT_ROW - END IF - SUCCESS = .FALSE. - END IF - END DO - - STRAT_O3_COLUMN = CONC_TO_DU * STRAT_O3_COLUMN - TROPO_O3_COLUMN = CONC_TO_DU * TROPO_O3_COLUMN - -#ifdef verbose_PHOT_MOD - IF( PHOT_COL .EQ. 1 .AND. PHOT_ROW .EQ. 1 )THEN - WRITE( NEW_OPTICS_LOG,*)'TOTAL_O3_COLUMN, TROPO_O3_COLUMN = ',TOTAL_O3_COLUMN, TROPO_O3_COLUMN - END IF -#endif - - IF ( .NOT. SUCCESS ) THEN - TROPO_O3_TOGGLE = MAX_TROPOO3_FRAC * TOTAL_O3_COLUMN - & / TROPO_O3_COLUMN - N_TROPO_O3_TOGGLE = N_TROPO_O3_TOGGLE + 1 - O3_TOGGLE_AVE = O3_TOGGLE_AVE + TROPO_O3_TOGGLE - O3_TOGGLE_MIN = MIN( O3_TOGGLE_MIN, TROPO_O3_TOGGLE) - STRATO3_MINS_MET = .FALSE. - STRAT_O3_COLUMN = CONC_TO_DU * STRAT_O3_COLMIN - IF( OBEY_STRATO3_MINS )THEN ! write to PE log for first occurance - WRITE( NEW_OPTICS_LOG, 99983)STRAT_O3_COLUMN - IF( ADJUST_OZONE ) WRITE( NEW_OPTICS_LOG, 99984)TROPO_O3_TOGGLE - WRITE( NEW_OPTICS_LOG, 99887) - WRITE( NEW_OPTICS_LOG, 99888)TOTAL_O3_COLUMN, TROPO_O3_COLUMN, MAX_TROPOO3_FRAC - WRITE( NEW_OPTICS_LOG, 99999) - OBEY_STRATO3_MINS = .FALSE. - END IF - IF( .NOT. ADJUST_OZONE ) TROPO_O3_TOGGLE = 1.0 ! reset toggle to one - ELSE - TROPO_O3_TOGGLE = 1.0 - END IF - - -99983 FORMAT( 'Corrective Action: 1) Stratospheric O3 column set to ',F8.3,' DU' ) -99984 FORMAT( 'and 2) Extinction from Model Domain O3 multiplied by ',F9.6 ) -99887 FORMAT(/'Check TROPO_O3_EXCEED and N_EXCEED_TROPO3 in PHOTDIAG1 file for ' - & /'values greater than zero to assess the extent of the ' - & /'problem. TROPO_O3_EXCEED and N_EXCEED_TROPO3 are the average ' - & /'exceedance and their number over file time step for each grid cell,' - & /'respectively. Exceedance depends on the predicted tropospheric' - & /'fraction over the maximum allowed fraction of the total ozone column.' - & /'Its value equals the ratio minus one if ratio is greater than one and' - & /'zero if the ratio is less than or equal to one. N_EXCEED_TROPO3 ' - & /'counts the number of nonzero values per timestep') -99888 FORMAT(/'Direct Cause: Predicted O3 tropospheric Column exceeds maximum allowed ' - & /'fraction of total OMI column.', - & /'OMI Total O3 Column = ',F8.3,' DU: Model Tropospheric O3 Column = ',F8.3,' DU', - & /'Climatological Expected Tropospheric Fraction = ',F9.6) -99999 FORMAT(/'ULTIMATE causes include boundary condition and meteorological input files. ' - & /'Check the former for unrealistic concentrations of ozone and its precursors.' - & /'Check the latter for unrealistic advection and diffusion parameters.') - - DO IWL = 1, NWL -!***Get optical depth for stratospheric ozone column -!***Note that stratosphere ozone coluumn assumed to exist above model domain - CALL GET_TAUO3 ( IWL, STRAT_O3_COLUMN, STRAT_TEMP, TAUO3_TOP( IWL ) ) -!***get Rayleigh optical depth for stratosphere - TAU_RAY( IWL ) = NBAR * SRAYL( IWL ) - END DO - END IF ! for NEW_PROFILE - -!***loop over wavelengths - DO IWL = 1, NWL ! outermost loop - -! RSFC = ALB( IWL ) ! surface albedo - -!***set scaling factor for reducing extraterrestrial flux -!*** add ozone and Rayleigh optical depths. Use the -!*** pseudospherical correction for the stratosphere. - - SOLAR_FLUX = FEXT( IWL ) / RSQD - -!*** initialize tau, delta tau's, other variables and loop over layers - - DTAU = 0.0 - DT_AERO = 0.0 - DT_CLOUD = 0.0 - DTSCAT_CLOUD = 0.0 - TAU_SCAT_CLD = 0.0 - - DO L = 2, NLAYS + 1 - II = NLAYS + 2 - L ! from top to bottom - -!***in the following statements the factor of 100.0 converts -!*** converts [ 1 / cm ] to [ 1 / m ] - - BETA_M = SRAYL( IWL ) * BLKDENS( II ) * 100.0 - AO3 = CSZ( II,IWL,LO3O3P ) * BLKO3 ( II ) * 100.0 - AO3 = TROPO_O3_TOGGLE * AO3 - ANO2 = CSZ( II,IWL,LNO2 ) * BLKNO2 ( II ) * 100.0 - -!***set up aerosol optical properties - - G_BAR = AERO_ASYM_FAC ( II,IWL ) - BEXT = AERO_EXTI_COEF( II,IWL ) - BSCAT = AERO_SCAT_COEF( II,IWL ) - -!***calculate total absorption and scattering contributions -!***to optical depth - -!***The contributions to scattering and absorption from molecules and particles -!*** are calculated separately to facilitate the calculation -!*** of the total single scatering albedo of the column of aerosols -!*** as measured by satellites. - - DTSCAT_M = BETA_M * BLKDZ( II ) ! molecular scattering - DTSCAT_A = BSCAT * BLKDZ( II ) ! particle scattering - - DTSCAT_M = MAX( DTSCAT_M, SMALL ) - DTSCAT_A = MAX( DTSCAT_A, SMALL ) - - - DTABS_M = ( AO3 + ANO2 ) * BLKDZ( II ) ! molecular absorption - DTABS_A = ( BEXT - BSCAT ) * BLKDZ( II ) ! particle absorption - - DTABS_M = MAX( DTABS_M, SMALL ) - DTABS_A = MAX( DTABS_A, SMALL ) - - IF ( CLOUDS( II ) ) THEN - - DT_CLOUD( L ) = ( CLOUD_LIQUID_EXT( II,IWL ) - & + CLOUD_ICE_EXT( II,IWL ) - & + CLOUD_AGGREG_EXT( II,IWL ) ) * BLKDZ( II ) - DTSCAT_CLOUD = ( CLOUD_LIQUID_SCAT( II,IWL ) - & + CLOUD_ICE_SCAT( II,IWL ) - & + CLOUD_AGGREG_SCAT( II,IWL ) ) * BLKDZ( II ) - -!Adjust DT_CLOUD for cloud fraction by 1/2 power of CLDFRC to approximate cloud overlap. -!Note that the power results because the resolved cloud conentrations are averaged over -!the grid cell so the net overlap correction equal cfrac**(3/2) from Briegleb (1992) times -!cfrac**(-1) for actual in-cloud concentrations (see Voulgarakis et al., 2009, Geosci Model -!Dev., vol. 2, pp. 59-72. - - IF ( CLOUD_LAYERING( II ) ) THEN - LAYERING_FACTOR = SQRT( CLDFRC( II ) ) - ELSE - LAYERING_FACTOR = CLDFRC( II ) - END IF - DT_CLOUD( L ) = DT_CLOUD( L ) * LAYERING_FACTOR - DTSCAT_CLOUD = DTSCAT_CLOUD * LAYERING_FACTOR - - TAU_SCAT_CLD = TAU_SCAT_CLD + DTSCAT_CLOUD - - IF ( DT_CLOUD( L ) .GT. 1.0E-6 ) THEN - OM_CLOUD = MAX( DTSCAT_CLOUD /DT_CLOUD( L ), 1.0) - IF ( OM_CLOUD .LT. 0.0 .OR. OM_CLOUD .GT. 1.0 .OR. OM_CLOUD .NE. OM_CLOUD) THEN - WRITE( NEW_OPTICS_LOG,'(A,I3,A,ES12.4,A)',ADVANCE = 'NO') - & 'OM_CLOUD( L = ', L, ' ) = ', OM_CLOUD,' resetting to ' - OM_CLOUD = MAX( 0.000001, MIN( OM_CLOUD, 0.99999)) - WRITE( NEW_OPTICS_LOG,'(ES12.4)')OM_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'LIQUID_EXT, LIQUID_SCAT = ', - & CLOUD_LIQUID_EXT( II,IWL ), CLOUD_LIQUID_SCAT( II,IWL ) - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'ICE_EXT, ICE_SCAT = ', - & CLOUD_ICE_EXT( II,IWL ), CLOUD_ICE_SCAT( II,IWL ) - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))')'AGGREG_EXT, AGGREG_SCAT = ', - & CLOUD_AGGREG_EXT( II,IWL ), CLOUD_AGGREG_SCAT( II,IWL ) - CALL M3EXIT( 'NEW_OPTICS', JDATE, JTIME, ' ', XSTAT1 ) - END IF - ELSE - OM_CLOUD = 1.0 - END IF - - IF ( DTSCAT_CLOUD .GT. 1.0E-6 ) THEN - - G_CLOUD = ( (CLOUD_LIQUID_ASY( II,IWL ) * CLOUD_LIQUID_SCAT( II,IWL )) - & + (CLOUD_ICE_ASY( II,IWL ) * CLOUD_ICE_SCAT( II,IWL )) - & + (CLOUD_AGGREG_ASY( II,IWL ) * CLOUD_AGGREG_SCAT( II,IWL )) ) - & * BLKDZ( II ) * LAYERING_FACTOR - -#ifdef phot_debug - IF ( .NOT. ONLY_SOLVE_RAD ) THEN - AVE_ASYMM_CLD( IWL ) = AVE_ASYMM_CLD( IWL ) + G_CLOUD - IF ( AVE_ASYMM_CLD( IWL ) .GT. TAU_SCAT_CLD ) THEN - WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) - & 'Sum for AVE_ASYMM_CLD at L (', L,') = ', AVE_ASYMM_CLD( IWL ), - & ' Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'AVE_ASYMM_CLD Increment = ', G_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'TAU_SCAT_CLD Increment = ', DTSCAT_CLOUD - END IF - END IF -#endif - - G_CLOUD = G_CLOUD / DTSCAT_CLOUD - - IF ( G_CLOUD .GE. 1.0 .OR. G_CLOUD .LE. -1.0 .OR. G_CLOUD .NE. G_CLOUD ) THEN - WRITE( NEW_OPTICS_LOG,'(A,I3,A,ES12.4,A)',ADVANCE = 'NO' ) - & 'G_CLOUD( L = ', L, ' ) = ', G_CLOUD,' resetting to ' - G_CLOUD = MIN( 0.9999, MAX( G_CLOUD, -0.9999) ) - WRITE( NEW_OPTICS_LOG,'(ES12.4)') G_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'LIQUID_ASY, LIQUID_SCAT = ', - & CLOUD_LIQUID_ASY( II,IWL ), CLOUD_LIQUID_SCAT( II,IWL ) - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'ICE_ASY, ICE_SCAT = ', - & CLOUD_ICE_ASY( II,IWL ), CLOUD_ICE_SCAT( II,IWL ) - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'AGGREG_ASY, AGGREG_SCAT = ', - & CLOUD_AGGREG_ASY( II,IWL ), CLOUD_AGGREG_SCAT( II,IWL ) - CALL M3EXIT( 'NEW_OPTICS', JDATE, JTIME, ' ', XSTAT1 ) - END IF - ELSE - G_CLOUD = 0.0 - END IF - ELSE - DTSCAT_CLOUD = 0.0 - G_CLOUD = 0.0 - OM_CLOUD = 1.0 - END IF - -!***calculate total absorption and scattering contributions -!***to optical depth - - DTSCAT = DTSCAT_M + DTSCAT_A + DTSCAT_CLOUD - DTABS = DTABS_M + DTABS_A + MAX(( 1.0 - OM_CLOUD ), 0.0) * DT_CLOUD( L ) - -!***set aerosol optical depth for later use - - DT_AERO ( L ) = BEXT * BLKDZ( II ) - -!***Now calculate the vertical profiles of optical depth, -!*** single scattering albedo, asymmetry factor -!*** and DSDH starting at the top. - - DTAU( L ) = DTSCAT + DTABS - OM ( L ) = DTSCAT / ( DTSCAT + DTABS ) - G ( L ) = ( G_BAR * DTSCAT_A + G_CLOUD * DTSCAT_CLOUD ) / DTSCAT - - IF ( G( L ) .GE. 1.0 .OR. G( L ) .LE. -1.0 .OR. G( L ) .NE. G( L ) ) THEN - WRITE( NEW_OPTICS_LOG,'(A,ES12.4,A)',ADVANCE = 'NO' ) - & 'G( L ) = ', G( L ),' resetting to ' - G( L ) = MIN( 0.9999, MAX( G( L ), -0.9999) ) - WRITE( NEW_OPTICS_LOG,'(ES12.4)')G( L ) - WRITE( NEW_OPTICS_LOG,'(A,10(1X,ES12.4))' ) - & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD, G_BAR, G_CLOUD = ', - & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD, G_BAR, G_CLOUD - END IF - - IF ( OM( L ) .GT. 1.0 .OR. OM( L ) .LE. 0.0 .OR. OM( L ) .NE. OM( L ) ) THEN - WRITE( NEW_OPTICS_LOG,'(A,ES12.4,A)',ADVANCE = 'NO' ) - & 'OM( L ) = ', OM( L ),' resetting to ' - OM( L ) = MIN( 0.9999, MAX( OM( L ), 0.0001) ) -#ifdef phot_debug - WRITE( NEW_OPTICS_LOG,'(ES12.4)' ) OM( L ) - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DTSCAT, DTABS, ( DTSCAT + DTABS) = ', - & DTSCAT, DTABS, ( DTSCAT + DTABS ) - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD = ', - & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DDTABS_M, DTABS_A, MAX(( 1.0-OM_CLOUD ), 0.0) * DT_CLOUD( L ) = ', - & DTABS_M, DTABS_A, MAX(( 1.0 - OM_CLOUD ), 0.0) * DT_CLOUD( L ) - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & ' AO3, ANO2,AERO_BEXT, AERO_BSCAT = ', - & AO3, ANO2,BEXT, BSCAT -#endif - ELSE -#ifdef phot_debug - IF ( OM( L ) .EQ. 1.0 ) THEN - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DTSCAT, DTABS, ( DTSCAT + DTABS ) = ', - & DTSCAT, DTABS, (DTSCAT + DTABS) - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD = ', - & DTSCAT_M, DTSCAT_A, DTSCAT_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'DDTABS_M, DTABS_A, MAX(( 1.0-OM_CLOUD ), 0.0) * DT_CLOUD( L ) = ', - & DTABS_M, DTABS_A, MAX(( 1.0 - OM_CLOUD ), 0.0 ) * DT_CLOUD( L) - WRITE( NEW_OPTICS_LOG,'(A,4(1X,ES12.4))' ) - & 'AO3, ANO2,AERO_BEXT, AERO_BSCAT = ', - & AO3, ANO2,BEXT, BSCAT - END IF -#endif - OM( L ) = MIN( 0.9999, OM( L ) ) - END IF - - DSDH_TD( L ) = DSDH( L - 1 ) - - IF ( ONLY_SOLVE_RAD ) CYCLE -!***FSB get sums of unscaled optical depths - - TAU_SCAT( IWL ) = TAU_SCAT ( IWL ) + DTSCAT_A - -!***initialize optical depth profiles to the layer increment - - TAUC_AERO( II,IWL ) = DT_AERO( L ) ! aerosol optical depth - TAU_TOT ( II,IWL ) = DTAU( L ) ! total optical depth - TAU_CLOUD( II,IWL ) = DT_CLOUD( L ) ! cloud optical depth - - END DO ! loop over layers - -!***set values for the stratosphere - - OM ( 1 ) = TAU_RAY( IWL ) / ( TAU_RAY( IWL ) + TAUO3_TOP( IWL ) ) - G ( 1 ) = 0.05 - DTAU ( 1 ) = TAUO3_TOP( IWL ) + TAU_RAY( IWL ) - DSDH_TD( 1 ) = DSDH_TOP - - NLEVEL = NLAYS + 1 - - IF ( .NOT. ONLY_SOLVE_RAD ) THEN -!***calculate optical depth profiles - TAU_TOT ( NLAYS,IWL ) = TAU_TOT ( NLAYS,IWL ) + DTAU( 1 ) - TAUC_AERO( NLAYS,IWL ) = TAUC_AERO( NLAYS,IWL ) + DT_AERO( 1 ) - TAU_CLOUD( NLAYS,IWL ) = TAU_CLOUD( NLAYS,IWL ) + DT_CLOUD( 1 ) - - DO L = NLAYS-1, 1, -1 - TAU_TOT ( L,IWL ) = TAU_TOT ( L,IWL ) + TAU_TOT ( L+1,IWL ) - TAUC_AERO( L,IWL ) = TAUC_AERO( L,IWL ) + TAUC_AERO( L+1,IWL ) - TAU_CLOUD( L,IWL ) = TAU_CLOUD( L,IWL ) + TAU_CLOUD( L+1,IWL ) - END DO - END IF - -!***Set fluxes to zero - - FDIR = 0.0 - FUP = 0.0 - FDN = 0.0 - EDIR = 0.0 - EUP = 0.0 - EDN = 0.0 - -!***calculate fluxes and irradiances - - CALL TWOSTREAM_S ( NLEVEL, COSZEN, ALB( IWL ), DTAU, OM, G, DSDH_TD, - & FDIR, FUP, FDN, EDIR, EUP, EDN ) - - DO L = 1, NLAYS - II = NLAYS + 2 - L - FSUM( L ) = FDIR( II ) + FDN( II ) + FUP( II ) ! actinic flux - ESUM( L ) = EDIR( II ) + EDN( II ) ! downward irradiance - END DO ! loop over layers - -! add diffusion and direct components for calculating reflectivity and transmissivity - INSOLATION = INSOLATION + SOLAR_FLUX - REFLECTION = REFLECTION + SOLAR_FLUX * EUP( 1 ) - TRANSMISSION = TRANSMISSION + SOLAR_FLUX * EDN( NLEVEL ) - TRANS_DIRECT = TRANS_DIRECT + SOLAR_FLUX * EDIR( NLEVEL ) - - IF ( ONLY_SOLVE_RAD ) CYCLE - -!***FSB Calculate column averaged scattering albedo and asymmetry factor - - IF ( TAUC_AERO( 1,IWL ) .GT. 1.0E-30 ) THEN - SSA_AERO( IWL ) = TAU_SCAT( IWL ) / TAUC_AERO( 1,IWL ) - END IF - - TOTAL_TAU_CLD( IWL ) = TAU_CLOUD( 1,IWL ) - -#ifdef phot_debug - IF ( TAU_CLOUD( 1,IWL ) .GT. 1.0E-20 ) THEN - IF ( AVE_ASYMM_CLD( IWL ) .GT. TAU_SCAT_CLD ) THEN - WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) - & 'Sum for AVE_ASYMM_CLD at L(', 1,') = ', AVE_ASYMM_CLD( IWL ), - & 'Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'AVE_ASYMM_CLD Increment = ', G_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'TAU_SCAT_CLD Increment = ', - & DTSCAT_CLOUD - END IF - IF ( TAU_SCAT_CLD .GT. 1.0E-20 ) THEN - AVE_ASYMM_CLD( IWL ) = AVE_ASYMM_CLD( IWL ) / TAU_SCAT_CLD - AVE_SSA_CLD ( IWL ) = TAU_SCAT_CLD / TAU_CLOUD( 1,IWL ) - ELSE - AVE_ASYMM_CLD( IWL ) = 0.0 - AVE_SSA_CLD ( IWL ) = 0.0 - END IF - IF ( ABS( AVE_ASYMM_CLD( IWL ) ) .GE. 1.0 ) THEN - WRITE( NEW_OPTICS_LOG,'(A,I3,2(A,ES12.4))' ) - & 'Sum for AVE_ASYMM_CLD at L(', 1,') = ', AVE_ASYMM_CLD( IWL )*TAU_SCAT_CLD, - & 'Sum for TAU_SCAT_CLD = ',TAU_SCAT_CLD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'AVE_ASYMM_CLD Increment = ', G_CLOUD - WRITE( NEW_OPTICS_LOG,'(A,2(ES12.4,1X))' ) - & 'TAU_SCAT_CLD Increment = ', DTSCAT_CLOUD - END IF - ELSE - TOTAL_TAU_CLD( IWL ) = 0.0 - AVE_SSA_CLD ( IWL ) = 0.0 - AVE_ASYMM_CLD( IWL ) = 0.0 - END IF -#endif - -!***FSB capture the total downward irradiance at the surface [ W / m**2] -! -! ETOT_SFC( IWL ) = CONV_WM2( IWL ) * FLXSCALE * FEXT( IWL ) -! & * ESUM( 1 ) - - FORALL( L = 1:NLAYS ) -!***multiply by the solar flux at the domain top for -!***actinic flux and irradiance; keeping actinic flux in photons/(cm^2*s) - ACTINIC_FLUX( L,IWL ) = SOLAR_FLUX * FSUM( L ) - IRRADIANCE ( L,IWL ) = SOLAR_FLUX * CONV_WM2( IWL ) * ESUM( L ) - END FORALL - END DO ! loop over wavelengths - -! normalize reflection and transmission coefficients - INSOLATION = 1.0 / ( COSZEN * INSOLATION ) - TRANS_DIRECT = TRANS_DIRECT * INSOLATION - REFLECTION = ONE_OVER_PI * REFLECTION * INSOLATION - TRANSMISSION = ONE_OVER_PI * TRANSMISSION * INSOLATION - - IF ( ONLY_SOLVE_RAD ) RETURN - -! compute photolysis rates - DO IPHOT = 1, NPHOTAB - DO IWL = 1, NWL - DO L = 1, NLAYS - BLKRJ( L,IPHOT ) = BLKRJ( L,IPHOT ) - & + ACTINIC_FLUX( L,IWL ) - & * CSZ( L,IWL,IPHOT ) * QYZ( L,IWL,IPHOT ) ! [ 1 / sec ] - END DO - END DO - END DO ! loop on layers, wavelength, IPHOT -! convert actinic flux to watts/m^2 - FORALL( L = 1:NLAYS, IWL=1:NWL ) - ACTINIC_FLUX( L,IWL ) = ACTINIC_FLUX( L,IWL ) * CONV_WM2( IWL ) - END FORALL - -!***compute rate of photolysis (j-values) for each reaction - -9503 FORMAT('LAYER = ',I3,' MODE = ',I3,' LAMBDA(nm) = ',ES12.4,' DGN_CORE(m) = ',ES12.4, - & ' DGN_SHELL(m) = ', ES12.4 / ' REFRACT_IDX_SHELL(NR,NI) = ', 2(ES12.4,1X), - & ' REFRACT_IDX_CORE(NR,NI) = ', 2(ES12.4,1X) / ' LN(GEO.STD.DEV.) = ', - & ES12.4) -9504 FORMAT('LAYER = ',I3,' MODE = ',I3,' LAMBDA(nm) = ',ES12.4,' DGN(m) = ',ES12.4, - & ' REFRACT_IDX(NR,NI) = ', 2(ES12.4,1X) / ' VOL.DENS. = ', ES12.4, - & ' LN(GEO.STD.DEV.) = ', ES12.4) - -99985 FORMAT('ERROR: Modeled Troposheric Ozone Column downward from layer ',I3,1X) -99986 FORMAT('exceeds Top Ozone Column based on OMI.data file. Negative Optical Depths ') -99987 FORMAT('but are physically unlikey.') -99988 FORMAT(' SETTING O3 Column ABOVE PTOP TO 25% of OMI.dat value ') -99989 FORMAT(' FOR ROW/COL = ',2(1X,I4)) - - RETURN - END SUBROUTINE NEW_OPTICS - -C/////////////////////////////////////////////////////////////////////// - - SUBROUTINE GETSRAY ( NWL, LAMDA, SRAYL ) -C----------------------------------------------------------------------- -C calculate molecular (Rayleigh) scattering cross section, srayl -C -C coded 09/08/2004 by Dr. Francis S. Binkowski -C Carolina Environmental Program -C University of North Carolina at Chapel Hill -C email: frank_binkowski@unc.edu -C -C Reference: -C Nicolet, M., On the molecular scattering in the terrestrial -C atmosphere: An empirical formula for its calculation in the -C homoshpere, Planetary and Space Science. Vol. 32,No. 11, -C Pages 1467-1468, November 1984. -C----------------------------------------------------------------------- - - IMPLICIT NONE - -!***arguments - - INTEGER, INTENT( IN ) :: NWL ! number of wavelength bins - REAL, INTENT( IN ) :: LAMDA( : ) ! wavelengths [nm] - REAL, INTENT( OUT ) :: SRAYL( : ) ! molecular scattering cross sections [cm**2] - -!***Internal variables - - INTEGER I - REAL WMICRN ! wavelenght in micrometers - REAL WMICRN1 ! 1 / wmicrn - REAL XX ! variable in Nicolet method - -!***get molecular scattering cross section. This is a fixed -!*** function of wavelength. - - DO I = 1, NWL - WMICRN = 1.0E-3 * LAMDA( I ) ! wavelength in micrometers - WMICRN1 = 1.0 / WMICRN - - IF ( WMICRN .LE. 0.55 ) THEN - XX = 3.6772 + 0.389 * WMICRN + 0.09426 * WMICRN1 - ELSE - XX = 4.04 - END IF - - SRAYL( I ) = 4.02E-28 * WMICRN1**XX ! in [cm**2] - - END DO - - RETURN - END SUBROUTINE GETSRAY - - - SUBROUTINE GET_TAUO3 ( IWL, STOZONE, STRAT_TEMP, TAU_O3 ) -C----------------------------------------------------------------------- -C subroutine to calculate the optical depth of ozone in the -C stratosphere -C -C special cross sections for calculating stratospheric ozone -C optical depth -C -C the following temperatures and cross sections are from -C Fast-J -C REFERENCE: -C Wild, O., X. Zhu, and M.J. Prather, Fast-J: Accurate simulation -C of in- and below-clolud photolysis in tropospheric chemical -C models, -C Journal of Atmospheric Chemistry, Vol. 37, pp 245-282, 2000 -C -C coded 10/20/2004 by Dr. Francis S. Binkowski -C Carolina Environmental Program -C University of North Carolina at Chapel Hill -C email: frank_binkowski@unc.edu -C Updated to Fast-JX version 5.0 -C Mar 2011 Bill Hutzell -C revised interpolation method for a general number of -C interpolation points -C -C----------------------------------------------------------------------- - - IMPLICIT NONE - -!***arguments - - INTEGER, INTENT( IN ) :: IWL ! wavelenth index - - REAL, INTENT( IN ) :: STOZONE ! ozone column amount [ DU ] - REAL, INTENT( IN ) :: STRAT_TEMP ! average temperature for stratosphere [ K ] - REAL, INTENT( OUT ) :: TAU_O3 ! optical depth for statosphere - -!***Local - - INTEGER IXT, IXTEMP - - REAL OZONE_CS ! interpolated ozone absorption cross section - REAL YTT ! interpolation variable - -!***Find temperature range: - - IF ( STRAT_TEMP .LE. TEMP_O3_STRAT( 1 ) ) IXTEMP = 0 - - DO IXT = 1, NTEMP_STRAT - 1 - IF ( STRAT_TEMP .GT. TEMP_O3_STRAT( IXT ) .AND. - & STRAT_TEMP .LT. TEMP_O3_STRAT( IXT + 1 ) ) THEN - IXTEMP = IXT - YTT = ( STRAT_TEMP - TEMP_O3_STRAT( IXT ) ) - & / ( TEMP_O3_STRAT( IXT + 1 ) - TEMP_O3_STRAT( IXT ) ) - END IF - END DO - - IF ( STRAT_TEMP .GE. TEMP_O3_STRAT( NTEMP_STRAT ) ) THEN - IXTEMP = NTEMP_STRAT - YTT = 0.0 - END IF - -!***do linear interpolation - - IF ( IXTEMP .EQ. 0 ) THEN - OZONE_CS = XO3CS( 1, IWL ) - ELSE IF ( IXTEMP .GE. 1 .AND. IXTEMP .LT. NTEMP_STRAT ) THEN - OZONE_CS = XO3CS( IXTEMP, IWL ) + - & ( XO3CS( IXTEMP+1, IWL ) - XO3CS( IXTEMP, IWL ) ) * YTT - ELSE IF ( IXTEMP .EQ. NTEMP_STRAT ) THEN - OZONE_CS = XO3CS( IXTEMP, IWL ) - END IF - - TAU_O3 = DU_TO_CONC * STOZONE * OZONE_CS - - RETURN - END SUBROUTINE GET_TAUO3 - -C/////////////////////////////////////////////////////////////////////// - - SUBROUTINE O3AMT ( XLAT, XLONG, MDAY, OZONE ) -C----------------------------------------------------------------------- -C This subroutine implements an algorithm for the annual behavior -C of total ozone ( taken here to be stratospheric) from -C climatology -C Reference: -C Van Heuklon, Thomas K., Estimating atmospheric ozone for solar -C radiation models, Solar Energy, Vol. 22, pp 63-68, 1979. -C updated from an earlier version by -C Dr. Francis S. Binkowski, The Carolina Environmental Program, -C The University of North Carolina at Chapel Hill. -C Email: frank_binkowski@unc.edu -C November 03. 2004. -C Only Northern Hemisphere is implemented. -C----------------------------------------------------------------------- - - IMPLICIT NONE - -!***arguments - - INTEGER, INTENT( IN ) :: MDAY ! Day number during the year - ! Jan 1st = 1.0, Feb 1st = 32, etc. - - REAL, INTENT( IN ) :: XLAT ! latitude of point on earth's surface - REAL, INTENT( IN ) :: XLONG ! longitude of point on earth's surface - REAL, INTENT( OUT ) :: OZONE ! Total column amount of ozone [ DU ] - -!***Internal: - -!***The following parameters are from Table 1 of Van Heuklon (1979). - - REAL, SAVE :: A, B, C, D, F, G, H, FJ - DATA A/150.0/, B/1.28/, C/40.0/, D/0.9865/, F/-30.0/, G/20.0/, - & H/3.0/, FJ/235.0/ - -!***FSB FJ is the equatorial annual average of atmospheric ozone -!*** content, as noted on page 65 of Nav Heulklon (1979). This value -!*** sets the basic background for ozone. - - REAL, PARAMETER :: RD = 0.017453 ! degrees to radians - -!***Variables of convenience - - REAL E, FI, BPHI, DEF, HLI, SINB, SINB2 - -!***set the day - - E = FLOAT( MDAY ) - FI = 20.0 - IF ( XLONG .LT. 0.0 ) FI = 0.0 - BPHI = B * XLAT * RD - DEF = D * ( E + F ) * RD - HLI = H * ( XLONG + FI ) * RD - SINB = SIN( BPHI ) - SINB2 = SINB * SINB - -!***the following equation implements equation (4) of VanHeuklon (1979) - - OZONE = FJ + ( A + C * SIN( DEF ) + G * SIN( HLI ) ) * SINB2 - - RETURN - END SUBROUTINE O3AMT - -C/////////////////////////////////////////////////////////////////////// - - SUBROUTINE SLANTPATH2 ( NLAYS, Z, ZSFC, REARTH, SINZEN, DZ, DSDH ) -C----------------------------------------------------------------------- -C PURPOSE: -C Calculate slant path, ds/dh, over vertical depth in spherical -C geometry also calculates the layer thicknesses. -C NOTE!!! -C This version is restricted to zenith angle less than 90 degrees -C----------------------------------------------------------------------- -C ARGUMENTS: -C INPUT: -C NLAYS - INTEGER, number of specified altitude levels -C z - REAL, altitude (agl) [m] <<< meters -C This is from file ZF ( full layers ) from METCRO3D -C Z(1) is zero. -C zsfc - REAL, ground elevation (msl) [m] -C rearth - REAL, radius of the earth [m] -C sinzen - REAL, sine of solar zenith angle -C -C OUTPUT: -C dz - REAL, layer thicknesses [ m ] -C dsdh - REAL, slant path of direct beam through each layer -C when travelling from the top of the atmosphere downward -C----------------------------------------------------------------------- -C EDIT HISTORY: -C Inspired by sphers from TUV -C 09/08/2004 modified to specialize for CMAQ application -C by Dr. Francis S. Binkowski -C Environmental Modeling for Policy Development group, -C The Carolina Environmental Program -C The University of North Carolina-Chapel Hill -C Email: frank_binkowski@unc.edu -C -C----------------------------------------------------------------------- -C REFERENCE: -C Dahlback, A. and K. Stamnes, A new spherical model for computing -C the radiation field available for photolysis and heating at -C twilight, Planetary and Space Sciences, Vol. 39, No. 5, -C pp 671-683, 1991. -C -C----------------------------------------------------------------------- - - IMPLICIT NONE - -!***arguments - - INTEGER, INTENT( IN ) :: NLAYS - - REAL, INTENT( IN ) :: Z ( : ) - REAL, INTENT( IN ) :: ZSFC - REAL, INTENT( IN ) :: REARTH - REAL, INTENT( IN ) :: SINZEN - REAL, INTENT( OUT ) :: DZ ( : ) ! layer thicknesses counting from surface upward - REAL, INTENT( OUT ) :: DSDH( : ) - -!***Internal - - INTEGER I, J, K ! loop indices - REAL RE - REAL DSJ ! slant path length [m] - REAL DHJ ! layer thickness [m] - REAL( 8 ) :: RJ, RJP1 - REAL( 8 ) :: RPSINZ ! rpsinz = (re + zd(i)) * sinzen - REAL( 8 ) :: RPSINZ2 ! rpsinz * rpsinz - REAL( 8 ) :: GA, GB ! see usage - REAL :: ZE( NLAYS + 1 ) ! altitudes MSL - REAL :: ZD( NLAYS + 1 ) ! array of altitudes indexed from top - REAL :: DZI( NLAYS ) ! layer thicknesses counting downward from the top - -C----------------------------------------------------------------------- - -!***re include the altitude above sea level to the radius of the earth - - RE = REARTH + ZSFC - -!***ze is the altitude above msl - - DO K = 1, NLAYS + 1 - ZE( K ) = Z( K ) -!!sjr ZE(K) = Z(K) - ZSFC - END DO - -!*** DZ(1) = ZE(2) - ZE(1) -!*** DZI(1) = ZE(NLAYS + 1) - ZE(NLAYS) - -!***calculate dz - - DO K = 1, NLAYS - DZ( K ) = ZE( K + 1 ) - ZE( K ) - END DO - -!***zd, dzi are inverse coordinates of ze & dz - - DO K = 1, NLAYS + 1 - J = NLAYS + 1 - K + 1 - ZD( J ) = ZE( K ) - END DO - - DO K = 1, NLAYS - J = NLAYS + 1 - K - DZI( J ) = DZ( K ) - END DO - -!***initialize dsdh - - DO I = 1, NLAYS - DSDH( I ) = 0.0 - END DO - -!***FSB The following code is a direct implementation of appendix B -!*** of Dahlbeck and Stamnes (1991) for the case of solar zenith -!*** angle less than 90 degree. - -!***calculate ds/dh of every layer starting at the top - - DO J = 1, NLAYS -!*** K = NLAYS - J +1 - RPSINZ = REAL( ( RE + ZD( J ) ) * SINZEN , 8 ) - RPSINZ2 = RPSINZ * RPSINZ - - IF ( J .LT. NLAYS ) THEN - RJ = REAL( RE + ZD( J ), 8 ) - RJP1 = REAL( RE + ZD( J + 1 ), 8 ) - DHJ = DZI( J ) - ELSE - RJ = REAL( RE + ZD( J ), 8) - RJP1 = REAL( RE, 8 ) - DHJ = DZI( J ) - END IF - -!***define GA and GB - - GB = SQRT( MAX( 0.0D0, RJ * RJ - RPSINZ2 ) ) - GA = SQRT( MAX( 0.0D0, RJP1 * RJP1 - RPSINZ2 ) ) - -!***This is equation B1 from Dahlbeck and Stamnes (1991) - - DSJ = ABS( REAL(GB - GA, 4 ) ) - -!***this is the slant path (Chapman) function. - - DSDH( J ) = DSJ / DHJ ! Note dsdh is on a top to bottom grid. - - END DO ! loop over altitude - - RETURN - END SUBROUTINE SLANTPATH2 - -C/////////////////////////////////////////////////////////////////////// - - SUBROUTINE SLANTPATHTOP ( ZTOM, ZTOA, ZSFC, REARTH, SINZEN, - & DSDHTOP ) -C----------------------------------------------------------------------- -C FSB This is a SPECIAL version to get the slant path from the top of -C the modeling domain (ztom) to the top of the atmosphere (ztoa). -C----------------------------------------------------------------------- -C PURPOSE: -C Calculate slant path, ds/dh, over vertical depth in spherical -C geometry also calculates the layer thicknesses. -C NOTE!!! -C This version is restricted to zenith angle less than 90 degrees -C----------------------------------------------------------------------- -C ARGUMENTS: -C INPUT: -C ztom - REAL, altitude (agl) of top of modeling domain [m] << 0 +!------------------------CANOPY PHOTOLYSIS CORRECTION/REDUCTION Section NOAA-ARL------------------------------------------- +!Conditions to reduce weighted average of photolysis rates (RJ) due to canopy shading (if user-defined=true); P. C. Campbell +!Following is based on work of ECCC in GEM-MACHv2.1: Makar et al. (2017) +!Makar, P., Staebler, R., Akingunola, A. et al. The effects of forest canopy shading and turbulence on boundary layer ozone. +!Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 + + !conditions for grid cells that do NOT have + !a continuous forest canopy + IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 +! & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 + & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 + & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 + & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 + & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 + & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN + RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, :) + ELSE ! There is a contiguous forest canopy,apply correctoin + !RJ_CORR effectly represents the beam attenuation and reduces photolysis. + !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. + !Meterol. 8, 25⚌~Z~L~@~S38 (1971). + +!Calculate attenuation at different set cumulative LAI fractions downward through canopy (C1R, C2R, C3R, C4R data from ECCC) + RJ_CORR_C1R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + & *Met_Data%C1R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) + RJ_CORR_C2R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + & *Met_Data%C2R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) + RJ_CORR_C3R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + & *Met_Data%C3R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) + RJ_CORR_C4R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + & *Met_Data%C4R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) + RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) + & *Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) + +!Interpolate to get attenuation profile below canopy + ZFL = Met_Data%ZF( COL,ROW,1 ) + ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy +! ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy + COUNTCAN = 0 ! Initialize canopy layers + DO WHILE (ZCAN.GE.0.5) !canopy threshold >= 0.5 m + IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN + COUNTCAN = COUNTCAN + 1 + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = 1.0 + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW ) .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.75 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW ) + YCAN(2) = 1.0 + XCAN(1) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(1) = RJ_CORR_C1R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.75 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.50 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(2) = RJ_CORR_C1R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(1) = RJ_CORR_C2R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.50 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.35 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(2) = RJ_CORR_C2R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(1) = RJ_CORR_C3R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.35 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(2) = RJ_CORR_C3R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(1) = RJ_CORR_C4R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(2) = RJ_CORR_C4R( COL,ROW ) + XCAN(1) = 0.5 + YCAN(1) = RJ_CORR_BOT( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + END IF + ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m +! WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), +! & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), +! & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) + END DO !end loop on canopy layers + +!Integrate to get best attenuation value to use within canopy + RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / + & ZFL +! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), +! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), +! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) +!Apply attenuation factors above and below canopy + RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) +!Apply attenuation value within canopy and take average above and within canopy values +! RJ( COL,ROW, 1, : ) = ( RJ( COL,ROW, 1, : ) +! & + (RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW )) )/2.0 + END IF !contigous canopy conditions + IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients IF ( ANY( CLOUDS ) ) THEN IF ( CFRAC_2D( COL,ROW ) .GT. 0.0 ) THEN ! resolved and subgrid clouds exist From 941e2353e85dc7214376ed696808c4558e082fbb Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Wed, 16 Feb 2022 21:25:10 +0000 Subject: [PATCH 04/72] Updated CMAQ makefiles for modified canopy codes. --- src/model/Makefile.am | 71 +++++++++++++------------- src/model/Makefile.in | 113 +++++++++++++++++++++++------------------- 2 files changed, 98 insertions(+), 86 deletions(-) diff --git a/src/model/Makefile.am b/src/model/Makefile.am index 61c4887..e27058a 100644 --- a/src/model/Makefile.am +++ b/src/model/Makefile.am @@ -163,7 +163,6 @@ libCCTM_a_SOURCES += \ $(PHOT)/CSQY_DATA.F \ $(PHOT)/OMI_1979_to_2015.dat \ $(PHOT)/opphot.F \ - $(PHOT)/phot.F \ $(PHOT)/PHOT_MET_DATA.F \ $(PHOT)/PHOT_MOD.F \ $(PHOT)/PHOTOLYSIS_ALBEDO.F \ @@ -214,7 +213,6 @@ libCCTM_a_SOURCES += \ $(UTIL)/bmatvec.F \ $(UTIL)/findex.f \ $(UTIL)/get_envlist.f \ - $(UTIL)/setup_logdev.F \ $(UTIL)/subhdomain.F \ $(UTIL)/UTILIO_DEFN.F @@ -223,7 +221,6 @@ VDIFF = $(CCTM)/vdiff/acm2 libVDIFF = $(VDIFF)/$(libCCTM)- libCCTM_a_SOURCES += \ $(VDIFF)/aero_sedv.F \ - $(VDIFF)/ASX_DATA_MOD.F \ $(VDIFF)/conv_cgrid.F \ $(VDIFF)/matrix1.F \ $(VDIFF)/opddep.F \ @@ -242,8 +239,10 @@ libCCTM_a_SOURCES += \ $(localCCTM)/o3totcol.f \ $(localCCTM)/vdiffacmx.F \ $(localCCTM)/PTMAP.F \ - $(localCCTM)/PT3D_DEFN.F - + $(localCCTM)/PT3D_DEFN.F \ + $(localCCTM)/phot.F \ + $(localCCTM)/ASX_DATA_MOD.F \ + $(localCCTM)/centralized_io_util_module.F libCCTM_a_CPPFLAGS = -DSUBST_FILES_ID=\"FILES_CTM.EXT\" libCCTM_a_CPPFLAGS += -DSUBST_CONST=\"CONST.EXT\" @@ -289,7 +288,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -301,7 +300,7 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ @@ -318,7 +317,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -347,11 +346,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -368,7 +367,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -378,7 +377,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -387,13 +386,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -405,7 +404,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -421,12 +420,12 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -439,7 +438,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -452,7 +451,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -461,7 +460,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -557,13 +556,6 @@ $(libPHOT)opphot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)GRID_CONF.$(OBJEXT) $(libPHOT)PHOT_MET_DATA.$(OBJEXT) \ $(libPHOT)PHOT_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libPHOT)phot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libPHOT)AERO_PHOTDATA.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libPHOT)CLOUD_OPTICS.$(OBJEXT) \ - $(libSTENEX)noop_modules.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ - $(libPHOT)PHOT_MET_DATA.$(OBJEXT) $(libPHOT)PHOT_MOD.$(OBJEXT) \ - $(libPHOT)PHOTOLYSIS_ALBEDO.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ - $(libPHOT)SEAS_STRAT_O3_MIN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libPHOT)PHOT_MET_DATA.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libPHOT)CLOUD_OPTICS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -620,12 +612,8 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -645,7 +633,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -657,7 +645,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -669,7 +657,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -679,3 +667,14 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)phot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libPHOT)AERO_PHOTDATA.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libPHOT)CLOUD_OPTICS.$(OBJEXT) \ + $(libSTENEX)noop_modules.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ + $(libPHOT)PHOT_MET_DATA.$(OBJEXT) $(libPHOT)PHOT_MOD.$(OBJEXT) \ + $(libPHOT)PHOTOLYSIS_ALBEDO.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ + $(libPHOT)SEAS_STRAT_O3_MIN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index 0c12a88..d5864b4 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -188,7 +188,6 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(PHOT)/libCCTM_a-complex_number_module.$(OBJEXT) \ $(PHOT)/libCCTM_a-CSQY_DATA.$(OBJEXT) \ $(PHOT)/libCCTM_a-opphot.$(OBJEXT) \ - $(PHOT)/libCCTM_a-phot.$(OBJEXT) \ $(PHOT)/libCCTM_a-PHOT_MET_DATA.$(OBJEXT) \ $(PHOT)/libCCTM_a-PHOT_MOD.$(OBJEXT) \ $(PHOT)/libCCTM_a-PHOTOLYSIS_ALBEDO.$(OBJEXT) \ @@ -222,7 +221,6 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(UTIL)/libCCTM_a-subhdomain.$(OBJEXT) \ $(UTIL)/libCCTM_a-UTILIO_DEFN.$(OBJEXT) \ $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT) \ - $(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT) \ $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT) \ $(VDIFF)/libCCTM_a-opddep.$(OBJEXT) \ @@ -237,7 +235,11 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(localCCTM)/libCCTM_a-o3totcol.$(OBJEXT) \ $(localCCTM)/libCCTM_a-vdiffacmx.$(OBJEXT) \ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) + $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-phot.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT) \ + libCCTM_a_OBJECTS = $(am_libCCTM_a_OBJECTS) AM_V_P = $(am__v_P_@AM_V@) am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) @@ -486,7 +488,7 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(PA)/PA_DEFN.F $(PA)/pa_update.F $(PHOT)/AERO_PHOTDATA.F \ $(PHOT)/CLOUD_OPTICS.F $(PHOT)/complex_number_module.F90 \ $(PHOT)/CSQY_DATA.F $(PHOT)/OMI_1979_to_2015.dat \ - $(PHOT)/opphot.F $(PHOT)/phot.F $(PHOT)/PHOT_MET_DATA.F \ + $(PHOT)/opphot.F $(PHOT)/PHOT_MET_DATA.F \ $(PHOT)/PHOT_MOD.F $(PHOT)/PHOTOLYSIS_ALBEDO.F \ $(PHOT)/PHOT_OPTICS.dat $(PHOT)/SEAS_STRAT_O3_MIN.F \ $(PHOT)/twoway_rrtmg_aero_optics.F90 $(PLRISE)/delta_zs.f \ @@ -504,13 +506,15 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(STENEX)/noop_util_module.f $(UTIL)/bmatvec.F \ $(UTIL)/findex.f $(UTIL)/get_envlist.f $(UTIL)/setup_logdev.F \ $(UTIL)/subhdomain.F $(UTIL)/UTILIO_DEFN.F \ - $(VDIFF)/aero_sedv.F $(VDIFF)/ASX_DATA_MOD.F \ + $(VDIFF)/aero_sedv.F \ $(VDIFF)/conv_cgrid.F $(VDIFF)/matrix1.F $(VDIFF)/opddep.F \ $(VDIFF)/opddep_fst.F $(VDIFF)/opddep_mos.F $(VDIFF)/rddepv.F \ $(VDIFF)/SEDIMENTATION.F $(VDIFF)/tri.F $(VDIFF)/VDIFF_DIAG.F \ $(VDIFF)/VDIFF_MAP.F $(VDIFF)/vdiffproc.F \ $(localCCTM)/o3totcol.f $(localCCTM)/vdiffacmx.F \ - $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F + $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F \ + $(localCCTM)/phot.F $(localCCTM)/ASX_DATA_MOD.F \ + $(localCCTM)/centralized_io_util_module.F # local version of CCTM source files localCCTM = $(builddir)/src @@ -883,8 +887,6 @@ $(PHOT)/libCCTM_a-CSQY_DATA.$(OBJEXT): $(PHOT)/$(am__dirstamp) \ $(PHOT)/$(DEPDIR)/$(am__dirstamp) $(PHOT)/libCCTM_a-opphot.$(OBJEXT): $(PHOT)/$(am__dirstamp) \ $(PHOT)/$(DEPDIR)/$(am__dirstamp) -$(PHOT)/libCCTM_a-phot.$(OBJEXT): $(PHOT)/$(am__dirstamp) \ - $(PHOT)/$(DEPDIR)/$(am__dirstamp) $(PHOT)/libCCTM_a-PHOT_MET_DATA.$(OBJEXT): $(PHOT)/$(am__dirstamp) \ $(PHOT)/$(DEPDIR)/$(am__dirstamp) $(PHOT)/libCCTM_a-PHOT_MOD.$(OBJEXT): $(PHOT)/$(am__dirstamp) \ @@ -981,8 +983,6 @@ $(VDIFF)/$(DEPDIR)/$(am__dirstamp): @: > $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ - $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ @@ -1022,6 +1022,14 @@ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT): \ $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-phot.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) + + libCCTM.a: $(libCCTM_a_OBJECTS) $(libCCTM_a_DEPENDENCIES) $(EXTRA_libCCTM_a_DEPENDENCIES) $(AM_V_at)-rm -f libCCTM.a @@ -1525,11 +1533,17 @@ $(PHOT)/libCCTM_a-opphot.o: $(PHOT)/opphot.F $(PHOT)/libCCTM_a-opphot.obj: $(PHOT)/opphot.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-opphot.obj `if test -f '$(PHOT)/opphot.F'; then $(CYGPATH_W) '$(PHOT)/opphot.F'; else $(CYGPATH_W) '$(srcdir)/$(PHOT)/opphot.F'; fi` -$(PHOT)/libCCTM_a-phot.o: $(PHOT)/phot.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-phot.o `test -f '$(PHOT)/phot.F' || echo '$(srcdir)/'`$(PHOT)/phot.F +$(localCCTM)/libCCTM_a-phot.o: $(localCCTM)/phot.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.o `test -f '$(localCCTM)/phot.F' || echo '$(localCCTM)/'`$(localCCTM)/phot.F + +$(localCCTM)/libCCTM_a-phot.obj: $(localCCTM)/phot.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.obj `if test -f '$(localCCTM)/phot.F'; then $(CYGPATH_W) '$(localCCTM)/phot.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/phot.F'; fi` -$(PHOT)/libCCTM_a-phot.obj: $(PHOT)/phot.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-phot.obj `if test -f '$(PHOT)/phot.F'; then $(CYGPATH_W) '$(PHOT)/phot.F'; else $(CYGPATH_W) '$(srcdir)/$(PHOT)/phot.F'; fi` +$(localCCTM)/libCCTM_a-centralized_io_util_module.o: $(localCCTM)/centralized_io_util_module.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o `test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(localCCTM)/'`$(localCCTM)/centralized_io_util_module.F + +$(localCCTM)/libCCTM_a-centralized_io_util_module.obj: $(localCCTM)/centralized_io_util_module.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.obj `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module.F'; fi` $(PHOT)/libCCTM_a-PHOT_MET_DATA.o: $(PHOT)/PHOT_MET_DATA.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-PHOT_MET_DATA.o `test -f '$(PHOT)/PHOT_MET_DATA.F' || echo '$(srcdir)/'`$(PHOT)/PHOT_MET_DATA.F @@ -1615,11 +1629,11 @@ $(VDIFF)/libCCTM_a-aero_sedv.o: $(VDIFF)/aero_sedv.F $(VDIFF)/libCCTM_a-aero_sedv.obj: $(VDIFF)/aero_sedv.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-aero_sedv.obj `if test -f '$(VDIFF)/aero_sedv.F'; then $(CYGPATH_W) '$(VDIFF)/aero_sedv.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/aero_sedv.F'; fi` -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.o: $(VDIFF)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(VDIFF)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(VDIFF)/ASX_DATA_MOD.F +$(localCCTM)/libCCTM_a-ASX_DATA_MOD.o: $(localCCTM)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(localCCTM)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(localCCTM)/ASX_DATA_MOD.F -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj: $(VDIFF)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(VDIFF)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(VDIFF)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/ASX_DATA_MOD.F'; fi` +$(localCCTM)/libCCTM_a-ASX_DATA_MOD.obj: $(localCCTM)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(localCCTM)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(localCCTM)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/ASX_DATA_MOD.F'; fi` $(VDIFF)/libCCTM_a-conv_cgrid.o: $(VDIFF)/conv_cgrid.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-conv_cgrid.o `test -f '$(VDIFF)/conv_cgrid.F' || echo '$(srcdir)/'`$(VDIFF)/conv_cgrid.F @@ -2164,7 +2178,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2176,7 +2190,7 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ @@ -2193,7 +2207,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -2222,11 +2236,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -2243,7 +2257,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -2253,7 +2267,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -2262,13 +2276,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -2280,7 +2294,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -2296,12 +2310,12 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -2314,7 +2328,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2327,7 +2341,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -2336,7 +2350,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -2432,13 +2446,6 @@ $(libPHOT)opphot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)GRID_CONF.$(OBJEXT) $(libPHOT)PHOT_MET_DATA.$(OBJEXT) \ $(libPHOT)PHOT_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libPHOT)phot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libPHOT)AERO_PHOTDATA.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libPHOT)CLOUD_OPTICS.$(OBJEXT) \ - $(libSTENEX)noop_modules.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ - $(libPHOT)PHOT_MET_DATA.$(OBJEXT) $(libPHOT)PHOT_MOD.$(OBJEXT) \ - $(libPHOT)PHOTOLYSIS_ALBEDO.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ - $(libPHOT)SEAS_STRAT_O3_MIN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libPHOT)PHOT_MET_DATA.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libPHOT)CLOUD_OPTICS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2495,12 +2502,8 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2520,7 +2523,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -2532,7 +2535,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -2544,7 +2547,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -2554,7 +2557,17 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) - +$(liblocalCCTM)phot.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libPHOT)AERO_PHOTDATA.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libPHOT)CLOUD_OPTICS.$(OBJEXT) \ + $(libSTENEX)noop_modules.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ + $(libPHOT)PHOT_MET_DATA.$(OBJEXT) $(libPHOT)PHOT_MOD.$(OBJEXT) \ + $(libPHOT)PHOTOLYSIS_ALBEDO.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ + $(libPHOT)SEAS_STRAT_O3_MIN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: From f1d72d18346a32a0809aa0b1f7a2e58a183d4e98 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Wed, 16 Feb 2022 21:59:34 +0000 Subject: [PATCH 05/72] Added new canopy variables to AQM shared components. --- src/shr/aqm_methods.F90 | 92 +++++++++++++++++++++++++++++++++++++++ src/shr/aqm_state_mod.F90 | 13 +++++- 2 files changed, 104 insertions(+), 1 deletion(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 656ce86..c8624b0 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -736,6 +736,98 @@ logical function interpx( fname, vname, pname, & buffer(k) = 0.01 * stateIn % zorl(c,r) end do end do + + ! canopy variables + case ("FCH") + !test forest canopy height set to 10 m + ! p2d => stateIn % cfch + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 + end do + end do + case ("FRT") + !test grid cell forest fraction to 0.5 + ! p2d => stateIn % cfrt + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 + end do + end do + case ("CLU") + !test forest clumping index set to 0.5 (spherical leaf distribution) + ! p2d => stateIn % cclu + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 !test set to 0.5 + end do + end do + case ("POPU") + !test pop. density set to 10000 people/10km2 + ! p2d => stateIn % cpopu + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10000.0 + end do + end do + case ("LAIE") + !test new ECCC LAI set to 4 + ! p2d => stateIn % claie + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 4.0 + end do + end do + case ("C1R") + !test new ECCC cumulative LAI fraction 1 (FCH to 0.75FCH) set to 0.5 + ! p2d => stateIn % cc1r + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 + end do + end do + case ("C2R") + !test new ECCC cumulative LAI fraction 2 (FCH to 0.5FCH) set to 0.7 + ! p2d => stateIn % cc2r + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.7 + end do + end do + case ("C3R") + !test new ECCC cumulative LAI fraction 3 (FCH to 0.35FCH) set to 0.9 + ! p2d => stateIn % cc3r + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.9 + end do + end do + case ("C4R") + !test new ECCC cumulative LAI fraction 4 (FCH to 0.20FCH) set to 0.95 + ! p2d => stateIn % cc4r + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.95 + end do + end do case default ! return end select diff --git a/src/shr/aqm_state_mod.F90 b/src/shr/aqm_state_mod.F90 index fc2c194..958d601 100644 --- a/src/shr/aqm_state_mod.F90 +++ b/src/shr/aqm_state_mod.F90 @@ -45,9 +45,20 @@ module aqm_state_mod real(AQM_KIND_R8), dimension(:,:,:,:), pointer :: tr => null() + ! -- canopy variables +! real(AQM_KIND_R8), dimension(:,:), pointer :: cfch => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cfrt => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cclu => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cpopu => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: claie => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cc1r => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cc2r => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cc3r => null() +! real(AQM_KIND_R8), dimension(:,:), pointer :: cc4r => null() + ! -- diagnostics real(AQM_KIND_R8), dimension(:,:), pointer :: aod => null() - + end type aqm_state_type public From c8a294c4d3663bfe97205649681a4d8c216986fd Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Wed, 16 Feb 2022 22:14:24 +0000 Subject: [PATCH 06/72] Added placeholder new canopy variables to aqm cap for fv3. --- src/aqm_cap.F90 | 10 ++++++++ src/aqm_comp_mod.F90 | 55 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+) diff --git a/src/aqm_cap.F90 b/src/aqm_cap.F90 index bfbee4a..d146465 100644 --- a/src/aqm_cap.F90 +++ b/src/aqm_cap.F90 @@ -13,6 +13,7 @@ module AQM ! -- import fields integer, parameter :: importFieldCount = 35 +! integer, parameter :: importFieldCount = 44 !with canopy character(len=*), dimension(importFieldCount), parameter :: & importFieldNames = (/ & "canopy_moisture_storage ", & @@ -50,6 +51,15 @@ module AQM "surface_cell_area ", & "surface_snow_area_fraction ", & "temperature_of_soil_layer " & +! "forest_canopy_height ", & +! "forest_fraction ", & +! "clumping_index ", & +! "population_density ", & +! "leaf_area_index_eccc ", & +! "cum_lai_frac1_eccc ", & +! "cum_lai_frac2_eccc ", & +! "cum_lai_frac3_eccc ", & +! "cum_lai_frac4_eccc ", & /) ! -- export fields integer, parameter :: exportFieldCount = 2 diff --git a/src/aqm_comp_mod.F90 b/src/aqm_comp_mod.F90 index 788fac9..75b182c 100644 --- a/src/aqm_comp_mod.F90 +++ b/src/aqm_comp_mod.F90 @@ -584,6 +584,61 @@ subroutine aqm_comp_import(state, fieldNames, rc) line=__LINE__, & file=__FILE__)) & return ! bail +!canopy variables +! case ("forest_canopy_height") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("forest_fraction") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("clumping_index") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("population_density") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("leaf_area_index_eccc") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("cum_lai_frac1_eccc") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("cum_lai_frac2_eccc") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("cum_lai_frac3_eccc") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail +! case ("cum_lai_frac4_eccc") +! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail case default ! -- unused field end select From 5d73df1bb677c0e9b847188628126cea96e88dcf Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 17 Feb 2022 15:13:49 +0000 Subject: [PATCH 07/72] Added conditional CANOPY_SHADE environment variable/logical. --- src/model/src/ASX_DATA_MOD.F | 26 +++++++++++++++++++++++++- src/model/src/phot.F | 28 +++++++++++++++++++++++++--- src/shr/aqm_config_mod.F90 | 1 + src/shr/aqm_methods.F90 | 4 ++++ 4 files changed, 55 insertions(+), 4 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 197be5f..251ceca 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -120,6 +120,13 @@ Module ASX_DATA_MOD Logical, Allocatable :: CONVCT ( :,: ) ! convection flag Real, Allocatable :: PBL ( :,: ) ! pbl height (m) Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) + +! Canopy in-line control + CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line + LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + PUBLIC CANOPY_SHADE + PRIVATE + !> Inline Canopy Processes Real, Allocatable :: FCH ( :,: ) ! Forest Canopy Height (m) Real, Allocatable :: FRT ( :,: ) ! Forest Fraction @@ -441,6 +448,20 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) C----------------------------------------------------------------------- +C In-line canopy shading option? (default = false) + + CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', + & 'Flag for in-line canopy shading', + & .FALSE., IOS ) + + IF ( CANOPY_SHADE ) THEN + XMSG = 'Using in-line canopy shading option' + CALL M3MSG2( XMSG ) + ELSE + RETURN + END IF + + LOGDEV = INIT3() If( MET_INITIALIZED )Return @@ -563,6 +584,7 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) Grid_Data%WRES = 0.0 Grid_Data%BSLP = 0.0 + If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), & Met_Data%CLU ( NCOLS,NROWS ), @@ -577,6 +599,7 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) XMSG = 'Failure allocating Canopy Shade variables' Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If + End If ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), @@ -1054,6 +1077,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) End If C Canopy vars + If ( CANOPY_SHADE ) Then VNAME = 'FCH' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, @@ -1125,7 +1149,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If - + End If C Soil vars VNAME = 'SOIM1' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, diff --git a/src/model/src/phot.F b/src/model/src/phot.F index f6722cc..5a2c80b 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -293,6 +293,11 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) LOGICAL :: NEW_PROFILE ! Has atmospheric temperature and density profile changed? LOGICAL :: DARK ! Are this processor's cells in darkness? +! Canopy in-line control + CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line + LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + PUBLIC CANOPY_SHADE + PRIVATE ! Canopy arrays REAL, ALLOCATABLE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) REAL, ALLOCATABLE :: RJ_CORR_C2R ( :, :) ! canopy shading correction to J-values (hc to 0.50*hc) @@ -349,6 +354,19 @@ END SUBROUTINE O3TOTCOL IF ( FIRSTIME ) THEN +C In-line canopy shading option? (default = false) + + CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', + & 'Flag for in-line canopy shading', + & .FALSE., IOS ) + + IF ( CANOPY_SHADE ) THEN + XMSG = 'Using in-line canopy shading option' + CALL M3MSG2( XMSG ) + ELSE + RETURN + END IF + FIRSTIME = .FALSE. LOGDEV = INIT3() @@ -397,10 +415,11 @@ END SUBROUTINE O3TOTCOL CALL INIT_CLOUD_OPTICS( ) !...Allocate and initialize new canopy arrays - ALLOCATE( RJ_CORRX ( MAXCAN ) ) - ALLOCATE( ZCANX ( MAXCAN ) ) + IF ( CANOPY_SHADE ) THEN + ALLOCATE( RJ_CORRX ( MAXCAN ) ) + ALLOCATE( ZCANX ( MAXCAN ) ) - ALLOCATE( RJ_CORR_C1R ( NCOLS, NROWS ), + ALLOCATE( RJ_CORR_C1R ( NCOLS, NROWS ), & RJ_CORR_C2R ( NCOLS, NROWS ), & RJ_CORR_C3R ( NCOLS, NROWS ), & RJ_CORR_C4R ( NCOLS, NROWS ), @@ -419,6 +438,7 @@ END SUBROUTINE O3TOTCOL RJ_CORR_C4R=0.0 RJ_CORR_BOT=0.0 RJ_CORR=0.0 + END IF !...Initialize Surface albedo method @@ -997,6 +1017,7 @@ END SUBROUTINE O3TOTCOL !Makar, P., Staebler, R., Akingunola, A. et al. The effects of forest canopy shading and turbulence on boundary layer ozone. !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 + IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) !conditions for grid cells that do NOT have !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 @@ -1102,6 +1123,7 @@ END SUBROUTINE O3TOTCOL ! RJ( COL,ROW, 1, : ) = ( RJ( COL,ROW, 1, : ) ! & + (RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW )) )/2.0 END IF !contigous canopy conditions + END IF !canopy shade IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients IF ( ANY( CLOUDS ) ) THEN diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index 84fc163..5eb35e8 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -35,6 +35,7 @@ module aqm_config_mod logical :: init_conc = .false. logical :: run_aero = .false. logical :: verbose = .false. + logical :: canopy_yn = .false. type(aqm_species_type), pointer :: species => null() end type aqm_config_type diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index c8624b0..1115240 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -330,6 +330,10 @@ logical function envyn(name, description, defaultval, status) envyn = associated(em) case ('CTM_GRAV_SETL') envyn = .false. + case ('CTM_CANOPY_SHADE') + envyn = config % canopy_yn !default (false) +! Just hard code to true right now...wait for runtime capability + envyn = .true. case ('INITIAL_RUN') envyn = .true. case default From 4a5f99ec4dd9d04a1147b3cd3adaff039f497ea4 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 17 Feb 2022 16:04:26 +0000 Subject: [PATCH 08/72] Updated conditional canopy_yn environment and logicals. --- examples/aqm.rc | 4 ++++ src/shr/aqm_config_mod.F90 | 15 +++++++++++++++ src/shr/aqm_methods.F90 | 4 ++-- 3 files changed, 21 insertions(+), 2 deletions(-) diff --git a/examples/aqm.rc b/examples/aqm.rc index e7e018c..0a3af4a 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -34,6 +34,10 @@ omi_data: /scratch1/NCEPDEV/nems/Raffaele.Montuoro/dev/aqm/epa/data/omi_cmaq_ # - set to true for cold start init_concentrations: true +# Run inline canopy effects +# +canopy_yn: false + # # Run aerosol module # diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index 5eb35e8..27a01fd 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -175,6 +175,14 @@ subroutine aqm_config_read(model, config, rc) rcToReturn=rc)) & return ! bail out + call ESMF_ConfigGetAttribute(cf, config % canopy_yn, & + label="canopy_yn:", default=.false., rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) & + return ! bail out + ! -- microphysics tracer map call ESMF_ConfigGetAttribute(cf, config % mp_map, & label="mp_tracer_map:", rc=localrc) @@ -485,6 +493,13 @@ subroutine aqm_config_log(config, name, rc) call ESMF_LogWrite(trim(name) // ": config: read: ctm_wb_dust: false", & ESMF_LOGMSG_INFO, rc=localrc) end if + if (config % canopy_yn) then + call ESMF_LogWrite(trim(name) // ": config: read: canopy_yn: true", & + ESMF_LOGMSG_INFO, rc=localrc) + else + call ESMF_LogWrite(trim(name) // ": config: read: canopy_yn: false", & + ESMF_LOGMSG_INFO, rc=localrc) + end if if (config % run_aero) then call ESMF_LogWrite(trim(name) // ": config: read: run_aerosol: true", & ESMF_LOGMSG_INFO, rc=localrc) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 1115240..72733cd 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -332,8 +332,6 @@ logical function envyn(name, description, defaultval, status) envyn = .false. case ('CTM_CANOPY_SHADE') envyn = config % canopy_yn !default (false) -! Just hard code to true right now...wait for runtime capability - envyn = .true. case ('INITIAL_RUN') envyn = .true. case default @@ -742,6 +740,7 @@ logical function interpx( fname, vname, pname, & end do ! canopy variables + if (config % ctm_wb_dust) then case ("FCH") !test forest canopy height set to 10 m ! p2d => stateIn % cfch @@ -832,6 +831,7 @@ logical function interpx( fname, vname, pname, & buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.95 end do end do + end if case default ! return end select From 8d6af39b63a9cf8bc6775c275a75ad26d81614d4 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 17 Feb 2022 17:43:32 +0000 Subject: [PATCH 09/72] Fixed bugs. --- src/model/Makefile.in | 4 ++-- src/model/src/ASX_DATA_MOD.F | 15 ++++++++------- src/model/src/phot.F | 4 ++-- src/shr/aqm_methods.F90 | 2 -- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index d5864b4..5ae221b 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -1540,10 +1540,10 @@ $(localCCTM)/libCCTM_a-phot.obj: $(localCCTM)/phot.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.obj `if test -f '$(localCCTM)/phot.F'; then $(CYGPATH_W) '$(localCCTM)/phot.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/phot.F'; fi` $(localCCTM)/libCCTM_a-centralized_io_util_module.o: $(localCCTM)/centralized_io_util_module.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o `test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(localCCTM)/'`$(localCCTM)/centralized_io_util_module.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o `test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(localCCTM)/'`$(localCCTM)/centralized_io_util_module.F $(localCCTM)/libCCTM_a-centralized_io_util_module.obj: $(localCCTM)/centralized_io_util_module.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.obj `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module.F'; fi` + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.obj `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module.F'; fi` $(PHOT)/libCCTM_a-PHOT_MET_DATA.o: $(PHOT)/PHOT_MET_DATA.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-PHOT_MET_DATA.o `test -f '$(PHOT)/PHOT_MET_DATA.F' || echo '$(srcdir)/'`$(PHOT)/PHOT_MET_DATA.F diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 251ceca..47e6904 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -121,12 +121,6 @@ Module ASX_DATA_MOD Real, Allocatable :: PBL ( :,: ) ! pbl height (m) Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) -! Canopy in-line control - CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line - LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading - PUBLIC CANOPY_SHADE - PRIVATE - !> Inline Canopy Processes Real, Allocatable :: FCH ( :,: ) ! Forest Canopy Height (m) Real, Allocatable :: FRT ( :,: ) ! Forest Fraction @@ -138,7 +132,6 @@ Module ASX_DATA_MOD Real, Allocatable :: C3R ( :,: ) ! cumulative LAI fraction hc to 0.35 * hc Real, Allocatable :: C4R ( :,: ) ! cumulative LAI fraction hc to 0.20 * hc - !> U and V wind components on the cross grid points Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] @@ -400,6 +393,14 @@ Module ASX_DATA_MOD DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. +! Canopy in-line control + CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line + LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + PUBLIC CANOPY_SHADE + PRIVATE + + INTEGER IOS ! i/o and allocate memory status + CONTAINS C======================================================================= diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 5a2c80b..122ea48 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -296,8 +296,6 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) ! Canopy in-line control CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading - PUBLIC CANOPY_SHADE - PRIVATE ! Canopy arrays REAL, ALLOCATABLE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) REAL, ALLOCATABLE :: RJ_CORR_C2R ( :, :) ! canopy shading correction to J-values (hc to 0.50*hc) @@ -341,6 +339,8 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) REAL, ALLOCATABLE, SAVE :: TAU_AERO ( :,:,:,: ) ! aerosol optical depth REAL, ALLOCATABLE, SAVE :: ACTINIC_FX( :,:,:,: ) ! net actinic flux [watts/m**2] + INTEGER IOS ! i/o and allocate memory status + INTERFACE SUBROUTINE O3TOTCOL ( LATITUDE, LONGITUDE, JDATE, OZONE ) INTEGER, INTENT( IN ) :: JDATE ! Julian day of the year (yyyyddd) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 72733cd..c23ee5b 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -740,7 +740,6 @@ logical function interpx( fname, vname, pname, & end do ! canopy variables - if (config % ctm_wb_dust) then case ("FCH") !test forest canopy height set to 10 m ! p2d => stateIn % cfch @@ -831,7 +830,6 @@ logical function interpx( fname, vname, pname, & buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.95 end do end do - end if case default ! return end select From d906997600e5199bb70ee0a6f52a3f1500f67c20 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 17 Feb 2022 19:03:53 +0000 Subject: [PATCH 10/72] Fixed more bugs. --- src/model/src/ASX_DATA_MOD.F | 38 +++++++++++++++--------------------- src/model/src/phot.F | 4 ++-- 2 files changed, 18 insertions(+), 24 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 47e6904..f2f8769 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -287,6 +287,11 @@ Module ASX_DATA_MOD Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var +! Canopy in-line control + CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line + LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + INTEGER IOSX ! i/o and allocate memory status + DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ @@ -393,14 +398,6 @@ Module ASX_DATA_MOD DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. -! Canopy in-line control - CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line - LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading - PUBLIC CANOPY_SHADE - PRIVATE - - INTEGER IOS ! i/o and allocate memory status - CONTAINS C======================================================================= @@ -449,20 +446,6 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) C----------------------------------------------------------------------- -C In-line canopy shading option? (default = false) - - CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', - & 'Flag for in-line canopy shading', - & .FALSE., IOS ) - - IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option' - CALL M3MSG2( XMSG ) - ELSE - RETURN - END IF - - LOGDEV = INIT3() If( MET_INITIALIZED )Return @@ -585,6 +568,17 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) Grid_Data%WRES = 0.0 Grid_Data%BSLP = 0.0 + CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', + & 'Flag for in-line canopy shading', + & .FALSE., IOSX ) + + IF ( CANOPY_SHADE ) THEN + XMSG = 'Using in-line canopy shading option' + CALL M3MSG2( XMSG ) + ELSE + RETURN + END IF + If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 122ea48..7514734 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -339,7 +339,7 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) REAL, ALLOCATABLE, SAVE :: TAU_AERO ( :,:,:,: ) ! aerosol optical depth REAL, ALLOCATABLE, SAVE :: ACTINIC_FX( :,:,:,: ) ! net actinic flux [watts/m**2] - INTEGER IOS ! i/o and allocate memory status + INTEGER IOSX ! i/o and allocate memory status INTERFACE SUBROUTINE O3TOTCOL ( LATITUDE, LONGITUDE, JDATE, OZONE ) @@ -358,7 +358,7 @@ END SUBROUTINE O3TOTCOL CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', & 'Flag for in-line canopy shading', - & .FALSE., IOS ) + & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN XMSG = 'Using in-line canopy shading option' From bb85b5ef09d1d6d4ee71bb89cd167b9d19593d39 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 24 Feb 2022 15:53:44 +0000 Subject: [PATCH 11/72] Removed "RETURN" bug and added diagnostic prints. --- src/model/src/ASX_DATA_MOD.F | 1 - src/model/src/phot.F | 19 ++++++++++++------- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index f2f8769..31ec03e 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -576,7 +576,6 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) ELSE - RETURN END IF If ( CANOPY_SHADE ) Then diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 7514734..d31a893 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -364,7 +364,6 @@ END SUBROUTINE O3TOTCOL XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) ELSE - RETURN END IF FIRSTIME = .FALSE. @@ -1018,6 +1017,12 @@ END SUBROUTINE O3TOTCOL !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) + WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , + & 'FCH = ', Met_Data%FCH( COL,ROW ), + & 'FRT = ', Met_Data%FRT( COL,ROW), + & 'POPU = ', Met_Data%POPU( COL,ROW), + & 'CLU = ', Met_Data%CLU( COL,ROW) + !conditions for grid cells that do NOT have !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 @@ -1106,17 +1111,17 @@ END SUBROUTINE O3TOTCOL RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) END IF ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m -! WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), -! & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), -! & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) + WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), + & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), + & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) END DO !end loop on canopy layers !Integrate to get best attenuation value to use within canopy RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL -! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), -! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), -! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) + WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), + & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), + & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) !Apply attenuation factors above and below canopy RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values From 07e3800d645b2d65358b8fe02e8a1648dfc86983 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 24 Feb 2022 16:40:40 +0000 Subject: [PATCH 12/72] Removed RETURN bug. --- src/model/src/ASX_DATA_MOD.F | 1 - src/model/src/phot.F | 1 - 2 files changed, 2 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 31ec03e..df72097 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -575,7 +575,6 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) IF ( CANOPY_SHADE ) THEN XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) - ELSE END IF If ( CANOPY_SHADE ) Then diff --git a/src/model/src/phot.F b/src/model/src/phot.F index d31a893..af05bc3 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -363,7 +363,6 @@ END SUBROUTINE O3TOTCOL IF ( CANOPY_SHADE ) THEN XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) - ELSE END IF FIRSTIME = .FALSE. From 685de08d2e8d234b13720b18a311b51bed92bc70 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Mon, 28 Feb 2022 22:44:20 +0000 Subject: [PATCH 13/72] Added debug statements --- src/shr/aqm_methods.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index c23ee5b..ac63288 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -644,6 +644,7 @@ logical function interpx( fname, vname, pname, & file=__FILE__, line=__LINE__)) return select case (trim(vname)) + print*,'vname_diag_test = ', vname case ("HFX") p2d => stateIn % hfx case ("LAI") @@ -748,6 +749,7 @@ logical function interpx( fname, vname, pname, & do c = col0, col1 k = k + 1 buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 + print*,'diag_fch_test = ', buffer(k) end do end do case ("FRT") From b00f1c810e38c3a40174f68eb1f2ceb9b995d025 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Tue, 1 Mar 2022 01:19:35 +0000 Subject: [PATCH 14/72] Removed debug prints and added canopy variables in DESC3. --- src/shr/aqm_methods.F90 | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index ac63288..9621b3b 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -148,7 +148,7 @@ LOGICAL FUNCTION DESC3( FNAME ) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_2D ) ) THEN - NVARS3D = 31 + NVARS3D = 40 VNAME3D( 1:NVARS3D ) = & (/ 'PRSFC ', 'USTAR ', & 'WSTAR ', 'PBL ', & @@ -165,7 +165,12 @@ LOGICAL FUNCTION DESC3( FNAME ) 'SLTYP ', 'Q2 ', & 'SEAICE ', 'SOIM1 ', & 'SOIM2 ', 'SOIT1 ', & - 'SOIT2 ', 'LH ' /) + 'SOIT2 ', 'LH ', & + 'FCH ', 'FRT ', & + 'CLU ', 'POPU ', & + 'LAIE ', 'C1R ', & + 'C2R ', 'C3R ', & + 'C4R ' /) UNITS3D( 1:NVARS3D ) = & (/ 'Pascal ', 'M/S ', & 'M/S ', 'M ', & @@ -182,7 +187,12 @@ LOGICAL FUNCTION DESC3( FNAME ) '- ', 'KG/KG ', & 'FRACTION ', 'M**3/M**3 ', & 'M**3/M**3 ', 'K ', & - 'K ', 'WATTS/M**2 ' /) + 'K ', 'WATTS/M**2 ', & + 'M ', 'NO UNIT ', & + 'NO UNIT ', 'PEOPLE/KM**2 ', & + 'NO UNIT ', 'NO UNIT ', & + 'NO UNIT ', 'NO UNIT ', & + 'NO UNIT ' /) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN @@ -644,7 +654,6 @@ logical function interpx( fname, vname, pname, & file=__FILE__, line=__LINE__)) return select case (trim(vname)) - print*,'vname_diag_test = ', vname case ("HFX") p2d => stateIn % hfx case ("LAI") @@ -749,7 +758,6 @@ logical function interpx( fname, vname, pname, & do c = col0, col1 k = k + 1 buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 - print*,'diag_fch_test = ', buffer(k) end do end do case ("FRT") From 846e1dc80844b6552c455a6824ae9c479994e29e Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Tue, 1 Mar 2022 03:05:08 +0000 Subject: [PATCH 15/72] Added some debug prints. --- src/model/src/ASX_DATA_MOD.F | 2 +- src/shr/aqm_methods.F90 | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index df72097..26b1189 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -576,7 +576,7 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) END IF - + WRITE(*,*) 'CANOPY_SHADE_Check = ', CANOPY_SHADE If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 9621b3b..0040125 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -758,6 +758,7 @@ logical function interpx( fname, vname, pname, & do c = col0, col1 k = k + 1 buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 + WRITE(*,*) 'FCH_Check = ', buffer(k) end do end do case ("FRT") From a816991c8143995cf4e334a196448adce7285237 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Wed, 2 Mar 2022 18:37:14 +0000 Subject: [PATCH 16/72] Updated debug statemetns --- src/model/src/ASX_DATA_MOD.F | 3 +-- src/model/src/phot.F | 5 +++-- src/shr/aqm_methods.F90 | 1 + 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 26b1189..7970b83 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -573,10 +573,9 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option' + XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD' CALL M3MSG2( XMSG ) END IF - WRITE(*,*) 'CANOPY_SHADE_Check = ', CANOPY_SHADE If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), diff --git a/src/model/src/phot.F b/src/model/src/phot.F index af05bc3..b3be964 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -295,7 +295,8 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) ! Canopy in-line control CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line - LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + ! Canopy arrays REAL, ALLOCATABLE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) REAL, ALLOCATABLE :: RJ_CORR_C2R ( :, :) ! canopy shading correction to J-values (hc to 0.50*hc) @@ -361,7 +362,7 @@ END SUBROUTINE O3TOTCOL & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option' + XMSG = 'Using in-line canopy shading option-phot' CALL M3MSG2( XMSG ) END IF diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 0040125..6c44dd5 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -746,6 +746,7 @@ logical function interpx( fname, vname, pname, & do c = col0, col1 k = k + 1 buffer(k) = 0.01 * stateIn % zorl(c,r) + WRITE(*,*) 'ZRUF_Check = ', buffer(k) end do end do From 8c5435819aa889722360e4511f31950c0f229852 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Wed, 2 Mar 2022 20:14:29 +0000 Subject: [PATCH 17/72] Fixed bug in declaration. --- src/model/src/phot.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index b3be964..8bf6e52 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -295,7 +295,7 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) ! Canopy in-line control CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE ' ! env var for in-line - LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading ! Canopy arrays REAL, ALLOCATABLE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) @@ -353,8 +353,6 @@ END SUBROUTINE O3TOTCOL ! ---------------------------------------------------------------------- - IF ( FIRSTIME ) THEN - C In-line canopy shading option? (default = false) CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', @@ -366,6 +364,8 @@ END SUBROUTINE O3TOTCOL CALL M3MSG2( XMSG ) END IF + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. LOGDEV = INIT3() From 830986e81b4141082296d339a52e80bf5eae884c Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 3 Mar 2022 01:46:14 +0000 Subject: [PATCH 18/72] Checking CANOPY_SHADE condition.. --- src/model/src/ASX_DATA_MOD.F | 10 +++++----- src/model/src/phot.F | 6 +++--- src/shr/aqm_methods.F90 | 1 - 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 7970b83..ac39066 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -573,10 +573,10 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD' + XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' CALL M3MSG2( XMSG ) END IF - If ( CANOPY_SHADE ) Then +! If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), & Met_Data%CLU ( NCOLS,NROWS ), @@ -591,7 +591,7 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) XMSG = 'Failure allocating Canopy Shade variables' Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If - End If +! End If ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), @@ -1069,7 +1069,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) End If C Canopy vars - If ( CANOPY_SHADE ) Then +! If ( CANOPY_SHADE ) Then VNAME = 'FCH' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, @@ -1141,7 +1141,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If - End If +! End If C Soil vars VNAME = 'SOIM1' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 8bf6e52..198f5c7 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -353,6 +353,8 @@ END SUBROUTINE O3TOTCOL ! ---------------------------------------------------------------------- + IF ( FIRSTIME ) THEN + C In-line canopy shading option? (default = false) CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', @@ -360,12 +362,10 @@ END SUBROUTINE O3TOTCOL & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option-phot' + XMSG = 'Using in-line canopy shading option-phot.F' CALL M3MSG2( XMSG ) END IF - IF ( FIRSTIME ) THEN - FIRSTIME = .FALSE. LOGDEV = INIT3() diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 6c44dd5..0040125 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -746,7 +746,6 @@ logical function interpx( fname, vname, pname, & do c = col0, col1 k = k + 1 buffer(k) = 0.01 * stateIn % zorl(c,r) - WRITE(*,*) 'ZRUF_Check = ', buffer(k) end do end do From cffa402f42362d957e6730b2617bbd3f9af6efdb Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 3 Mar 2022 17:52:09 +0000 Subject: [PATCH 19/72] Updated Canopy debugs --- src/model/src/ASX_DATA_MOD.F | 18 +++++++++--------- src/shr/aqm_methods.F90 | 4 ++-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index ac39066..0fcdd2c 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -289,7 +289,7 @@ Module ASX_DATA_MOD ! Canopy in-line control CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line - LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading INTEGER IOSX ! i/o and allocate memory status DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ @@ -568,14 +568,14 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) Grid_Data%WRES = 0.0 Grid_Data%BSLP = 0.0 - CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', - & 'Flag for in-line canopy shading', - & .FALSE., IOSX ) - - IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' - CALL M3MSG2( XMSG ) - END IF +! CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', +! & 'Flag for in-line canopy shading', +! & .FALSE., IOSX ) +! +! IF ( CANOPY_SHADE ) THEN +! XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' +! CALL M3MSG2( XMSG ) +! END IF ! If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 0040125..551851b 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -757,8 +757,8 @@ logical function interpx( fname, vname, pname, & do r = row0, row1 do c = col0, col1 k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 - WRITE(*,*) 'FCH_Check = ', buffer(k) +! buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 + buffer(k) = 10.0 end do end do case ("FRT") From 7d49ad1ebe4e736f4f2f759b8575639352aed032 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Thu, 3 Mar 2022 21:40:35 +0000 Subject: [PATCH 20/72] Fixed CANOPY_SHADE logic bug and added debug prints. --- src/model/src/ASX_DATA_MOD.F | 57 ++++++++++++++++++------------------ src/shr/aqm_methods.F90 | 5 ++-- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 0fcdd2c..52acaf3 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -289,7 +289,7 @@ Module ASX_DATA_MOD ! Canopy in-line control CHARACTER( 20 ), SAVE :: CTM_CANOPY_SHADE = 'CTM_CANOPY_SHADE '! env var for in-line - LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading + LOGICAL, PUBLIC, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading INTEGER IOSX ! i/o and allocate memory status DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ @@ -568,31 +568,6 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) Grid_Data%WRES = 0.0 Grid_Data%BSLP = 0.0 -! CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', -! & 'Flag for in-line canopy shading', -! & .FALSE., IOSX ) -! -! IF ( CANOPY_SHADE ) THEN -! XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' -! CALL M3MSG2( XMSG ) -! END IF -! If ( CANOPY_SHADE ) Then - ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), - & Met_Data%FRT ( NCOLS,NROWS ), - & Met_Data%CLU ( NCOLS,NROWS ), - & Met_Data%POPU ( NCOLS,NROWS ), - & Met_Data%LAIE ( NCOLS,NROWS ), - & Met_Data%C1R ( NCOLS,NROWS ), - & Met_Data%C2R ( NCOLS,NROWS ), - & Met_Data%C3R ( NCOLS,NROWS ), - & Met_Data%C4R ( NCOLS,NROWS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating Canopy Shade variables' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If -! End If - ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), @@ -653,6 +628,32 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) ChemMos_Data%SubName = subname End If +!> ccccccccccccccccccccc canopy shade option!ccccccccccccccccccccc + CANOPY_SHADE = ENVYN( 'CTM_CANOPY_SHADE', + & 'Flag for in-line canopy shading', + & .FALSE., IOSX ) + + IF ( CANOPY_SHADE ) THEN + XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' + CALL M3MSG2( XMSG ) + END IF + If ( CANOPY_SHADE ) Then + ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), + & Met_Data%FRT ( NCOLS,NROWS ), + & Met_Data%CLU ( NCOLS,NROWS ), + & Met_Data%POPU ( NCOLS,NROWS ), + & Met_Data%LAIE ( NCOLS,NROWS ), + & Met_Data%C1R ( NCOLS,NROWS ), + & Met_Data%C2R ( NCOLS,NROWS ), + & Met_Data%C3R ( NCOLS,NROWS ), + & Met_Data%C4R ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Canopy Shade variables' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + !> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc If ( .Not. desc3( met_cro_2d ) ) Then @@ -1069,7 +1070,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) End If C Canopy vars -! If ( CANOPY_SHADE ) Then + If ( CANOPY_SHADE ) Then VNAME = 'FCH' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, @@ -1141,7 +1142,7 @@ Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) End If -! End If + End If C Soil vars VNAME = 'SOIM1' If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 551851b..4561829 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -757,8 +757,7 @@ logical function interpx( fname, vname, pname, & do r = row0, row1 do c = col0, col1 k = k + 1 -! buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 - buffer(k) = 10.0 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 end do end do case ("FRT") @@ -778,7 +777,7 @@ logical function interpx( fname, vname, pname, & do r = row0, row1 do c = col0, col1 k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 !test set to 0.5 + buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 end do end do case ("POPU") From c3bc815d636caca9204be30a02c8cf8cf28f053b Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Fri, 4 Mar 2022 02:38:26 +0000 Subject: [PATCH 21/72] Removed extraneous debug prints. --- src/model/src/ASX_DATA_MOD.F | 8 ++++---- src/model/src/phot.F | 18 +++++++++--------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F index 52acaf3..49f851d 100755 --- a/src/model/src/ASX_DATA_MOD.F +++ b/src/model/src/ASX_DATA_MOD.F @@ -633,10 +633,10 @@ Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) & 'Flag for in-line canopy shading', & .FALSE., IOSX ) - IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option-ASX_DATA_MOD.F' - CALL M3MSG2( XMSG ) - END IF +! IF ( CANOPY_SHADE ) THEN +! XMSG = 'Using in-line canopy shading option' +! CALL M3MSG2( XMSG ) +! END IF If ( CANOPY_SHADE ) Then ALLOCATE( Met_Data%FCH ( NCOLS,NROWS ), & Met_Data%FRT ( NCOLS,NROWS ), diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 198f5c7..9f0c077 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -362,7 +362,7 @@ END SUBROUTINE O3TOTCOL & .FALSE., IOSX ) IF ( CANOPY_SHADE ) THEN - XMSG = 'Using in-line canopy shading option-phot.F' + XMSG = 'Using in-line canopy shading option' CALL M3MSG2( XMSG ) END IF @@ -1017,11 +1017,11 @@ END SUBROUTINE O3TOTCOL !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) - WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , - & 'FCH = ', Met_Data%FCH( COL,ROW ), - & 'FRT = ', Met_Data%FRT( COL,ROW), - & 'POPU = ', Met_Data%POPU( COL,ROW), - & 'CLU = ', Met_Data%CLU( COL,ROW) +! WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , +! & 'FCH = ', Met_Data%FCH( COL,ROW ), +! & 'FRT = ', Met_Data%FRT( COL,ROW), +! & 'POPU = ', Met_Data%POPU( COL,ROW), +! & 'CLU = ', Met_Data%CLU( COL,ROW) !conditions for grid cells that do NOT have !a continuous forest canopy @@ -1119,9 +1119,9 @@ END SUBROUTINE O3TOTCOL !Integrate to get best attenuation value to use within canopy RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL - WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), - & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), - & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) +! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), +! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), +! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) !Apply attenuation factors above and below canopy RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values From 2a26402768459d9c0949af0e62fca2e503387fa1 Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Fri, 4 Mar 2022 04:42:18 +0000 Subject: [PATCH 22/72] Removed debug prints. --- src/model/src/phot.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 9f0c077..fe83f6d 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1111,9 +1111,9 @@ END SUBROUTINE O3TOTCOL RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) END IF ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m - WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), - & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), - & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) +! WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), +! & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), +! & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) END DO !end loop on canopy layers !Integrate to get best attenuation value to use within canopy From 2ee012f2fea0a0e8170e57cf82e9c276f09ca7ca Mon Sep 17 00:00:00 2001 From: "Patrick.C.Campbell@noaa.gov" Date: Sat, 5 Mar 2022 14:15:04 +0000 Subject: [PATCH 23/72] Fixed allocation/save bug. --- src/model/src/phot.F | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index fe83f6d..86ad888 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -298,14 +298,14 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) LOGICAL, SAVE :: CANOPY_SHADE ! flag in-lining canopy shading ! Canopy arrays - REAL, ALLOCATABLE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) - REAL, ALLOCATABLE :: RJ_CORR_C2R ( :, :) ! canopy shading correction to J-values (hc to 0.50*hc) - REAL, ALLOCATABLE :: RJ_CORR_C3R ( :, :) ! canopy shading correction to J-values (hc to 0.35*hc) - REAL, ALLOCATABLE :: RJ_CORR_C4R ( :, :) ! canopy shading correction to J-values (hc to 0.20*hc) - REAL, ALLOCATABLE :: RJ_CORR_BOT ( :, :) ! canopy shading correction to J-values (0.20*hc to bottom) - REAL, ALLOCATABLE :: RJ_CORR ( :, :) ! total/integrated canopy shading correction to J-values - REAL, ALLOCATABLE :: ZCANX ( : ) ! canopy heights[m] - REAL, ALLOCATABLE :: RJ_CORRX ( : ) ! canopy height dependent photolysis attenuation factor + REAL, ALLOCATABLE, SAVE :: RJ_CORR_C1R ( :, :) ! canopy shading correction to J-values (hc to 0.75*hc) + REAL, ALLOCATABLE, SAVE :: RJ_CORR_C2R ( :, :) ! canopy shading correction to J-values (hc to 0.50*hc) + REAL, ALLOCATABLE, SAVE :: RJ_CORR_C3R ( :, :) ! canopy shading correction to J-values (hc to 0.35*hc) + REAL, ALLOCATABLE, SAVE :: RJ_CORR_C4R ( :, :) ! canopy shading correction to J-values (hc to 0.20*hc) + REAL, ALLOCATABLE, SAVE :: RJ_CORR_BOT ( :, :) ! canopy shading correction to J-values (0.20*hc to bottom) + REAL, ALLOCATABLE, SAVE :: RJ_CORR ( :, :) ! total/integrated canopy shading correction to J-values + REAL, ALLOCATABLE, SAVE :: ZCANX ( : ) ! canopy heights[m] + REAL, ALLOCATABLE, SAVE :: RJ_CORRX ( : ) ! canopy height dependent photolysis attenuation factor REAL :: XCAN ( 2 ) ! canopy height interpolation bounds REAL :: YCAN ( 2 ) ! photolysisattenuation interpolation bounds REAL ZFL, ZCAN, COUNTCAN, XCANOUT ! local canopyvariables From 6cc3005187796ec3adf378064105931681203e05 Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Mon, 21 Mar 2022 15:56:50 -0400 Subject: [PATCH 24/72] Update Makefile.in Fixed Makefile.in typo. --- src/model/Makefile.in | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index 5ae221b..4d3ea17 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -238,8 +238,7 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) \ $(localCCTM)/libCCTM_a-phot.$(OBJEXT) \ $(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT) \ - + $(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT) libCCTM_a_OBJECTS = $(am_libCCTM_a_OBJECTS) AM_V_P = $(am__v_P_@AM_V@) am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) From 43c9948c8d2315f0986a486d7698d32ff3f6956a Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Mon, 21 Mar 2022 17:39:46 -0400 Subject: [PATCH 25/72] Update Makefile.in --- src/model/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index 4d3ea17..09eebf2 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -1533,13 +1533,13 @@ $(PHOT)/libCCTM_a-opphot.obj: $(PHOT)/opphot.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(PHOT)/libCCTM_a-opphot.obj `if test -f '$(PHOT)/opphot.F'; then $(CYGPATH_W) '$(PHOT)/opphot.F'; else $(CYGPATH_W) '$(srcdir)/$(PHOT)/opphot.F'; fi` $(localCCTM)/libCCTM_a-phot.o: $(localCCTM)/phot.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.o `test -f '$(localCCTM)/phot.F' || echo '$(localCCTM)/'`$(localCCTM)/phot.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.o `test -f '$(localCCTM)/phot.F' || echo '$(srcdir)/'`$(localCCTM)/phot.F $(localCCTM)/libCCTM_a-phot.obj: $(localCCTM)/phot.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-phot.obj `if test -f '$(localCCTM)/phot.F'; then $(CYGPATH_W) '$(localCCTM)/phot.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/phot.F'; fi` $(localCCTM)/libCCTM_a-centralized_io_util_module.o: $(localCCTM)/centralized_io_util_module.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o `test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(localCCTM)/'`$(localCCTM)/centralized_io_util_module.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o `test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(srcdir)/'`$(localCCTM)/centralized_io_util_module.F $(localCCTM)/libCCTM_a-centralized_io_util_module.obj: $(localCCTM)/centralized_io_util_module.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.obj `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module.F'; fi` From 0bef3bed9e47edd14171c4419c95c1bad39b886b Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Tue, 29 Mar 2022 18:07:38 +0000 Subject: [PATCH 26/72] Added new canopy file to read for AQM. --- examples/aqm.rc | 1 + 1 file changed, 1 insertion(+) diff --git a/examples/aqm.rc b/examples/aqm.rc index 0a3af4a..6cea1b3 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -37,6 +37,7 @@ init_concentrations: true # Run inline canopy effects # canopy_yn: false +canopy_file: /scratch2/NAGAPE/arl/Patrick.C.Campbell/canopy_geofiles/gfs.t12z.geo.08.canopy_regrid.nc # # Run aerosol module From 9b0939744e751e8cc5b9466f37f93db742d9a00e Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Tue, 29 Mar 2022 18:22:39 +0000 Subject: [PATCH 27/72] Updated aqm.rc example file. --- examples/aqm.rc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/aqm.rc b/examples/aqm.rc index 6cea1b3..b7ec0f2 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -36,7 +36,7 @@ init_concentrations: true # Run inline canopy effects # -canopy_yn: false +canopy_yn: true canopy_file: /scratch2/NAGAPE/arl/Patrick.C.Campbell/canopy_geofiles/gfs.t12z.geo.08.canopy_regrid.nc # From 3daa4b6d9e88b9b67d19889c9dbc23570a05dfda Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Wed, 30 Mar 2022 01:24:59 +0000 Subject: [PATCH 28/72] Updated example aqm.rc for canopy settings and file. --- examples/aqm.rc | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/examples/aqm.rc b/examples/aqm.rc index b7ec0f2..6d805d6 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -34,11 +34,30 @@ omi_data: /scratch1/NCEPDEV/nems/Raffaele.Montuoro/dev/aqm/epa/data/omi_cmaq_ # - set to true for cold start init_concentrations: true -# Run inline canopy effects +# +# Inline Canopy Effects # canopy_yn: true + +canopy_type: canopy + +canopy_format: netcdf + canopy_file: /scratch2/NAGAPE/arl/Patrick.C.Campbell/canopy_geofiles/gfs.t12z.geo.08.canopy_regrid.nc +canopy_frequency: static + +canopy_species:: + FCH 1.00000 FCH m + FRT 1.00000 FRT unitless + CLU 1.00000 CLU unitless + POPU 1.00000 POPU 10000_people/10km2 + LAIE 1.00000 LAIE cm2/cm2 + C1R 1.00000 C1R cm2/cm2 + C2R 1.00000 C2R cm2/cm2 + C3R 1.00000 C3R cm2/cm2 + C4R 1.00000 C4R cm2/cm2 + # # Run aerosol module # From cc0d3e253ce48a5e04186c056cd7505926cbe5be Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Wed, 30 Mar 2022 03:20:26 +0000 Subject: [PATCH 29/72] Initial changes for reading canopy data in AQM. --- src/shr/aqm_methods.F90 | 144 ++++++++++++++++++++-------------------- 1 file changed, 72 insertions(+), 72 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index a579595..7aa7787 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -751,95 +751,95 @@ logical function interpx( fname, vname, pname, & ! canopy variables case ("FCH") - !test forest canopy height set to 10 m ! p2d => stateIn % cfch - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10.0 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("FRT") - !test grid cell forest fraction to 0.5 ! p2d => stateIn % cfrt - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("CLU") - !test forest clumping index set to 0.5 (spherical leaf distribution) ! p2d => stateIn % cclu - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("POPU") - !test pop. density set to 10000 people/10km2 ! p2d => stateIn % cpopu - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 10000.0 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("LAIE") - !test new ECCC LAI set to 4 ! p2d => stateIn % claie - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 4.0 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("C1R") - !test new ECCC cumulative LAI fraction 1 (FCH to 0.75FCH) set to 0.5 ! p2d => stateIn % cc1r - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.5 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("C2R") - !test new ECCC cumulative LAI fraction 2 (FCH to 0.5FCH) set to 0.7 ! p2d => stateIn % cc2r - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.7 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("C3R") - !test new ECCC cumulative LAI fraction 3 (FCH to 0.35FCH) set to 0.9 ! p2d => stateIn % cc3r - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.9 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case ("C4R") - !test new ECCC cumulative LAI fraction 4 (FCH to 0.20FCH) set to 0.95 ! p2d => stateIn % cc4r - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = ( 0.0 * stateIn % zorl(c,r) ) + 0.95 - end do - end do + if (config % canopy_yn) then + call aqm_emis_read("canopy", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read canopy for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0. + end if case default ! return end select From 035efa105202f50d234f9704c884d1ce0c625310 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Wed, 30 Mar 2022 18:11:05 +0000 Subject: [PATCH 30/72] Updated aqm_emis_read and aqm.rc for canopy variables. --- examples/aqm.rc | 17 +++++++++-------- src/shr/aqm_emis_mod.F90 | 7 +++++++ 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/examples/aqm.rc b/examples/aqm.rc index 6d805d6..5066518 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -49,14 +49,15 @@ canopy_frequency: static canopy_species:: FCH 1.00000 FCH m - FRT 1.00000 FRT unitless - CLU 1.00000 CLU unitless + FRT 1.00000 FRT 1 + CLU 1.00000 CLU 1 POPU 1.00000 POPU 10000_people/10km2 - LAIE 1.00000 LAIE cm2/cm2 - C1R 1.00000 C1R cm2/cm2 - C2R 1.00000 C2R cm2/cm2 - C3R 1.00000 C3R cm2/cm2 - C4R 1.00000 C4R cm2/cm2 + LAIE 1.00000 LAIE 1 + C1R 1.00000 C1R 1 + C2R 1.00000 C2R 1 + C3R 1.00000 C3R 1 + C4R 1.00000 C4R 1 +:: # # Run aerosol module @@ -89,7 +90,7 @@ ctm_pmdiag: true emission_sources: myemis # -# Emission type: anthropogenic, biogenic, gbbepx +# Emission type: anthropogenic, biogenic, gbbepx, canopy # myemis_type: anthropogenic diff --git a/src/shr/aqm_emis_mod.F90 b/src/shr/aqm_emis_mod.F90 index 5590ef1..0e36216 100644 --- a/src/shr/aqm_emis_mod.F90 +++ b/src/shr/aqm_emis_mod.F90 @@ -1160,6 +1160,13 @@ subroutine aqm_emis_read(etype, spcname, buffer, localDe, rc) if (present(rc)) rc = AQM_RC_FAILURE return ! bail out end if + + if (trim(em % type) == "canopy") then + ! -- ensure canopy variables are not normalized by area like + ! -- emissions conversions below + em % dens_flag(item) = 1 + end if + select case (em % dens_flag(item)) case (:-1) ! -- this case indicates that input emissions are provided as totals/cell From f427465049d86b4aabe1c1f9276bc5bdeeebf47a Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Mon, 4 Apr 2022 00:26:41 +0000 Subject: [PATCH 31/72] Updated bug to get aqm_get_config. --- src/shr/aqm_methods.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 7aa7787..696d74a 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -653,6 +653,11 @@ logical function interpx( fname, vname, pname, & if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return + call aqm_model_get(config=config, stateIn=stateIn, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & + file=__FILE__, line=__LINE__)) return + + select case (trim(vname)) case ("HFX") p2d => stateIn % hfx From 30bccdb876802863ba80eba51d15d70489df64ca Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Tue, 14 Jun 2022 16:12:07 +0000 Subject: [PATCH 32/72] Updated for local in-canopy modified codes. --- aqm_files.cmake | 3 +++ 1 file changed, 3 insertions(+) diff --git a/aqm_files.cmake b/aqm_files.cmake index c3f7420..b6c0d24 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -231,4 +231,7 @@ list(APPEND aqm_CCTM_files ${localCCTM}/vdiffacmx.F ${localCCTM}/PTMAP.F ${localCCTM}/PT3D_DEFN.F + ${localCCTM}/phot.F + ${localCCTM}/ASX_DATA_MOD.F + ${localCCTM}/centralized_io_util_module.F ) From 1c1f75895bfe54d4276a72172abbe0d9c9beb2ce Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Tue, 14 Jun 2022 16:27:13 +0000 Subject: [PATCH 33/72] Moved ASX_DATA_MOD to compile above Phot.F --- aqm_files.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/aqm_files.cmake b/aqm_files.cmake index b6c0d24..8493a22 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -231,7 +231,7 @@ list(APPEND aqm_CCTM_files ${localCCTM}/vdiffacmx.F ${localCCTM}/PTMAP.F ${localCCTM}/PT3D_DEFN.F - ${localCCTM}/phot.F ${localCCTM}/ASX_DATA_MOD.F + ${localCCTM}/phot.F ${localCCTM}/centralized_io_util_module.F ) From 4044777e08c133a9c672bd266bd36efb520e3034 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Tue, 14 Jun 2022 16:37:43 +0000 Subject: [PATCH 34/72] Updated to remove default ASX_DATA_MOD and phot.F --- aqm_files.cmake | 2 -- 1 file changed, 2 deletions(-) diff --git a/aqm_files.cmake b/aqm_files.cmake index 8493a22..5798ed0 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -180,7 +180,6 @@ list(APPEND aqm_CCTM_files ${PHOT}/CSQY_DATA.F ${PHOT}/OMI_1979_to_2015.dat ${PHOT}/opphot.F - ${PHOT}/phot.F ${PHOT}/PHOT_MET_DATA.F ${PHOT}/PHOT_MOD.F ${PHOT}/PHOTOLYSIS_ALBEDO.F @@ -215,7 +214,6 @@ list(APPEND aqm_CCTM_files ${UTIL}/subhdomain.F ${UTIL}/UTILIO_DEFN.F ${VDIFF}/aero_sedv.F - ${VDIFF}/ASX_DATA_MOD.F ${VDIFF}/conv_cgrid.F ${VDIFF}/matrix1.F ${VDIFF}/opddep.F From 43588af77cf86ee9f24cc67437d625d0ebede984 Mon Sep 17 00:00:00 2001 From: bbakernoaa Date: Wed, 3 Aug 2022 14:09:23 +0000 Subject: [PATCH 35/72] updates --- aqm_files.cmake | 6 +- src/model/Makefile.am | 64 +- src/model/Makefile.in | 109 +- src/model/src/ASX_DATA_MOD.F | 1463 +++++++++++++++++++ src/model/src/ASX_DATA_MOD.F~ | 1459 +++++++++++++++++++ src/model/src/DUST_EMIS.F | 1525 ++++++++++++++++++++ src/model/src/centralized_io_util_module.F | 282 ++++ 7 files changed, 4828 insertions(+), 80 deletions(-) create mode 100755 src/model/src/ASX_DATA_MOD.F create mode 100755 src/model/src/ASX_DATA_MOD.F~ create mode 100644 src/model/src/DUST_EMIS.F create mode 100644 src/model/src/centralized_io_util_module.F diff --git a/aqm_files.cmake b/aqm_files.cmake index c3f7420..22bd6af 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -130,7 +130,6 @@ list(APPEND aqm_CCTM_files ${EMIS}/BEIS_DEFN.F ${EMIS}/BIOG_EMIS.F ${EMIS}/cropcal.F - ${EMIS}/DUST_EMIS.F ${EMIS}/EMIS_DEFN.F ${EMIS}/LTNG_DEFN.F ${EMIS}/LUS_DEFN.F @@ -215,7 +214,6 @@ list(APPEND aqm_CCTM_files ${UTIL}/subhdomain.F ${UTIL}/UTILIO_DEFN.F ${VDIFF}/aero_sedv.F - ${VDIFF}/ASX_DATA_MOD.F ${VDIFF}/conv_cgrid.F ${VDIFF}/matrix1.F ${VDIFF}/opddep.F @@ -231,4 +229,8 @@ list(APPEND aqm_CCTM_files ${localCCTM}/vdiffacmx.F ${localCCTM}/PTMAP.F ${localCCTM}/PT3D_DEFN.F + ${localCCTM}/ASX_DATA_MOD.F + ${localCCTM}/centralized_io_util_module.F + ${localCCTM}/DUST_EMIS.F ) + diff --git a/src/model/Makefile.am b/src/model/Makefile.am index 61c4887..909b66e 100644 --- a/src/model/Makefile.am +++ b/src/model/Makefile.am @@ -79,7 +79,6 @@ libCCTM_a_SOURCES += \ $(EMIS)/BEIS_DEFN.F \ $(EMIS)/BIOG_EMIS.F \ $(EMIS)/cropcal.F \ - $(EMIS)/DUST_EMIS.F \ $(EMIS)/EMIS_DEFN.F \ $(EMIS)/LTNG_DEFN.F \ $(EMIS)/LUS_DEFN.F \ @@ -223,7 +222,6 @@ VDIFF = $(CCTM)/vdiff/acm2 libVDIFF = $(VDIFF)/$(libCCTM)- libCCTM_a_SOURCES += \ $(VDIFF)/aero_sedv.F \ - $(VDIFF)/ASX_DATA_MOD.F \ $(VDIFF)/conv_cgrid.F \ $(VDIFF)/matrix1.F \ $(VDIFF)/opddep.F \ @@ -242,7 +240,11 @@ libCCTM_a_SOURCES += \ $(localCCTM)/o3totcol.f \ $(localCCTM)/vdiffacmx.F \ $(localCCTM)/PTMAP.F \ - $(localCCTM)/PT3D_DEFN.F + $(localCCTM)/PT3D_DEFN.F \ + $(localCCTM)/ASX_DATA_MOD.F \ + $(localCCTM)/centralized_io_util_module.F \ + $(localCCTM)/DUST_EMIS.F + libCCTM_a_CPPFLAGS = -DSUBST_FILES_ID=\"FILES_CTM.EXT\" @@ -289,7 +291,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -301,8 +303,8 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(liblocalCCTM)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) \ @@ -318,7 +320,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -347,11 +349,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -368,7 +370,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -378,7 +380,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -387,13 +389,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -405,7 +407,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -420,13 +422,9 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ - $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ - $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -439,7 +437,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -452,7 +450,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -461,7 +459,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -620,12 +618,8 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -645,7 +639,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -657,7 +651,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -669,7 +663,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -679,3 +673,11 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index 0c12a88..e6ef50a 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -143,7 +143,6 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(EMIS)/libCCTM_a-BEIS_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-BIOG_EMIS.$(OBJEXT) \ $(EMIS)/libCCTM_a-cropcal.$(OBJEXT) \ - $(EMIS)/libCCTM_a-DUST_EMIS.$(OBJEXT) \ $(EMIS)/libCCTM_a-EMIS_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-LTNG_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-LUS_DEFN.$(OBJEXT) \ @@ -222,7 +221,6 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(UTIL)/libCCTM_a-subhdomain.$(OBJEXT) \ $(UTIL)/libCCTM_a-UTILIO_DEFN.$(OBJEXT) \ $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT) \ - $(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT) \ $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT) \ $(VDIFF)/libCCTM_a-opddep.$(OBJEXT) \ @@ -237,7 +235,10 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(localCCTM)/libCCTM_a-o3totcol.$(OBJEXT) \ $(localCCTM)/libCCTM_a-vdiffacmx.$(OBJEXT) \ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) + $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT) \ + $(localCCTM)/libCCTM_a-DUST_EMIS.$(OBJEXT) libCCTM_a_OBJECTS = $(am_libCCTM_a_OBJECTS) AM_V_P = $(am__v_P_@AM_V@) am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) @@ -468,7 +469,7 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(DEPV)/MOSAIC_MOD.F $(DEPV)/opdepv_diag.F \ $(DEPV)/opdepv_mos.F $(DEPV)/opdepv_fst.F $(DEPV)/m3dry.F \ $(EMIS)/BEIS_DEFN.F $(EMIS)/BIOG_EMIS.F $(EMIS)/cropcal.F \ - $(EMIS)/DUST_EMIS.F $(EMIS)/EMIS_DEFN.F $(EMIS)/LTNG_DEFN.F \ + $(EMIS)/EMIS_DEFN.F $(EMIS)/LTNG_DEFN.F \ $(EMIS)/LUS_DEFN.F $(EMIS)/MGEMIS.F $(EMIS)/opemis.F \ $(EMIS)/PTBILIN.F $(EMIS)/SSEMIS.F $(EMIS)/STK_EMIS.F \ $(EMIS)/STK_PRMS.F $(EMIS)/tfabove.F $(EMIS)/tfbelow.F \ @@ -504,13 +505,15 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(STENEX)/noop_util_module.f $(UTIL)/bmatvec.F \ $(UTIL)/findex.f $(UTIL)/get_envlist.f $(UTIL)/setup_logdev.F \ $(UTIL)/subhdomain.F $(UTIL)/UTILIO_DEFN.F \ - $(VDIFF)/aero_sedv.F $(VDIFF)/ASX_DATA_MOD.F \ + $(VDIFF)/aero_sedv.F \ $(VDIFF)/conv_cgrid.F $(VDIFF)/matrix1.F $(VDIFF)/opddep.F \ $(VDIFF)/opddep_fst.F $(VDIFF)/opddep_mos.F $(VDIFF)/rddepv.F \ $(VDIFF)/SEDIMENTATION.F $(VDIFF)/tri.F $(VDIFF)/VDIFF_DIAG.F \ $(VDIFF)/VDIFF_MAP.F $(VDIFF)/vdiffproc.F \ $(localCCTM)/o3totcol.f $(localCCTM)/vdiffacmx.F \ - $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F + $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F \ + $(localCCTM)/ASX_DATA_MOD.F \ + $(localCCTM)/centralized_io_util_module.F $(localCCTM)/DUST_EMIS.F # local version of CCTM source files localCCTM = $(builddir)/src @@ -757,8 +760,6 @@ $(EMIS)/libCCTM_a-BIOG_EMIS.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-cropcal.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) -$(EMIS)/libCCTM_a-DUST_EMIS.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ - $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-EMIS_DEFN.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-LTNG_DEFN.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ @@ -981,8 +982,6 @@ $(VDIFF)/$(DEPDIR)/$(am__dirstamp): @: > $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ - $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ @@ -1022,6 +1021,12 @@ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT): \ $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) +$(localCCTM)/libCCTM_a-DUST_EMIS.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ + $(localCCTM)/$(DEPDIR)/$(am__dirstamp) libCCTM.a: $(libCCTM_a_OBJECTS) $(libCCTM_a_DEPENDENCIES) $(EXTRA_libCCTM_a_DEPENDENCIES) $(AM_V_at)-rm -f libCCTM.a @@ -1273,11 +1278,13 @@ $(EMIS)/libCCTM_a-cropcal.o: $(EMIS)/cropcal.F $(EMIS)/libCCTM_a-cropcal.obj: $(EMIS)/cropcal.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-cropcal.obj `if test -f '$(EMIS)/cropcal.F'; then $(CYGPATH_W) '$(EMIS)/cropcal.F'; else $(CYGPATH_W) '$(srcdir)/$(EMIS)/cropcal.F'; fi` -$(EMIS)/libCCTM_a-DUST_EMIS.o: $(EMIS)/DUST_EMIS.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-DUST_EMIS.o `test -f '$(EMIS)/DUST_EMIS.F' || echo '$(srcdir)/'`$(EMIS)/DUST_EMIS.F +$(localCCTM)/libCCTM_a-DUST_EMIS.o: $(localCCTM)/DUST_EMIS.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-DUST_EMIS.o `test -f '$(local +CCTM)/DUST_EMIS.F' || echo '$(srcdir)/'`$(localCCTM)/DUST_EMIS.F -$(EMIS)/libCCTM_a-DUST_EMIS.obj: $(EMIS)/DUST_EMIS.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-DUST_EMIS.obj `if test -f '$(EMIS)/DUST_EMIS.F'; then $(CYGPATH_W) '$(EMIS)/DUST_EMIS.F'; else $(CYGPATH_W) '$(srcdir)/$(EMIS)/DUST_EMIS.F'; fi` +$(localCCTM)/libCCTM_a-DUST_EMIS.obj: $(localCCTM)/DUST_EMIS.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-DUST_EMIS.obj `if test -f '$( +localCCTM)/DUST_EMIS.F'; then $(CYGPATH_W) '$(localCCTM)/DUST_EMIS.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/DUST_EMIS.F'; fi` $(EMIS)/libCCTM_a-EMIS_DEFN.o: $(EMIS)/EMIS_DEFN.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-EMIS_DEFN.o `test -f '$(EMIS)/EMIS_DEFN.F' || echo '$(srcdir)/'`$(EMIS)/EMIS_DEFN.F @@ -1615,11 +1622,20 @@ $(VDIFF)/libCCTM_a-aero_sedv.o: $(VDIFF)/aero_sedv.F $(VDIFF)/libCCTM_a-aero_sedv.obj: $(VDIFF)/aero_sedv.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-aero_sedv.obj `if test -f '$(VDIFF)/aero_sedv.F'; then $(CYGPATH_W) '$(VDIFF)/aero_sedv.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/aero_sedv.F'; fi` -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.o: $(VDIFF)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(VDIFF)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(VDIFF)/ASX_DATA_MOD.F ++$(localCCTM)/libCCTM_a-centralized_io_util_module.o: $(localCCTM)/centralized_io_util_module.F ++ $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o +`test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(srcdir)/'`$(localCCTM)/centralized_io_util_module.F ++ ++$(localCCTM)/libCCTM_a-centralized_io_util_module.obj: $(localCCTM)/centralized_io_util_module.F ++ $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.ob +j `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module +.F'; fi` -$(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj: $(VDIFF)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(VDIFF)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(VDIFF)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/ASX_DATA_MOD.F'; fi` +$(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.o: $(liblocalCCTM)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(liblocalCCTM)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(liblocalCCTM)/ASX_DATA_MOD.F + +$(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.obj: $(liblocalCCTM)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(liblocalCCTM)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(liblocalCCTM)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(liblocalCCTM)/ASX_DATA_MOD.F'; fi` $(VDIFF)/libCCTM_a-conv_cgrid.o: $(VDIFF)/conv_cgrid.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-conv_cgrid.o `test -f '$(VDIFF)/conv_cgrid.F' || echo '$(srcdir)/'`$(VDIFF)/conv_cgrid.F @@ -2164,7 +2180,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2176,8 +2192,8 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(liblocalCCTM)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) \ @@ -2193,7 +2209,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -2222,11 +2238,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -2243,7 +2259,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -2253,7 +2269,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -2262,13 +2278,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -2280,7 +2296,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -2295,13 +2311,9 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ - $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ - $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -2314,7 +2326,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2327,7 +2339,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -2336,7 +2348,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -2495,12 +2507,8 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2520,7 +2528,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -2532,7 +2540,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -2544,7 +2552,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -2554,7 +2562,14 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) - +$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(liblocalCCTM)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F new file mode 100755 index 0000000..160183f --- /dev/null +++ b/src/model/src/ASX_DATA_MOD.F @@ -0,0 +1,1463 @@ +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module ASX_DATA_MOD + +C----------------------------------------------------------------------- +C Function: User-defined types + +C Revision History: +C 19 Aug 2014 J.Bash: initial implementation +C 17 July 2015 H.Foroutan: Updated the calculation of MOL, MOLI, HOL, and WSTAR +C 25 Aug 2015 H. Pye: Added IEPOX, HACET surrogates +C modified PROPNN and H2O2 +C Increased ar for ozone from 8 to 12. +C Change meso from 0.1 to 0 for some org. nitrates +C Changes based on Nguyen et al. 2015 PNAS and SOAS +C +C---------Notes +C * Updates based on literature review 7/96 JEP +C # Diff and H based on Wesely (1988) same as RADM +C + Estimated by JEP 2/97 +C @ Updated by JEP 9/01 +C ~ Added by YW 1/02. Dif0 based on Massman (1998). Henry's Law constant +C is defined here as: h=cg/ca, where cg is the concentration of a species +C in gas-phase, and ca is its aqueous-phase concentration. The smaller h, +C the larger solubility. Henry's Law constant in another definition (KH): +C KH = ca/pg [M/atm], KH = KH0 * exp(-DKH/R(1/T-1/T0)), where KH0 and -DKH +C values are from Rolf Sander (1999). h=1/(KH*R*T). +C ** Update by DBS based on estimates by JEP 1/03 +C ^^ From Bill Massman, personal communication 4/03 +C ## Diffusivity calculated by SPARC, reactivity = other aldehydes +C ++ Dif0 in Massman is diffusivity at temperature 0C and 1 atm (101.325kPa), so +C chemicals that were not in Massman's paper need to be adjusted. We assume +C JEP's original values were for 25C and 1 atm. +C % Added by G. Sarwar (10/04) +C $ Added by R. Bullock (02/05) HG diffusivity is from Massman (1999). +C HGIIGAS diffusivity calculated from the HG value and a mol. wt. scaling +C factor of MW**(-2/3) from EPA/600/3-87/015. ORD, Athens, GA. HGIIGAS +C mol.wt. used is that of HgCl2. Reactivity of HG is 1/20th of NO and NO2 +C values based on general atmospheric lifetimes of each species. Reactivity +C of HGIIGAS is based on HNO3 surrogate. +C @@ Mesophyll resistances for NO, NO2, and CO added by J. Pleim (07/07) based +C on values in Pleim, Venkatram, and Yamartino, 1984: ADOM/TADAP Model +C Development Program, Volume 4, The Dry Deposition Module. ERT, Inc., +C Concord, MA (peer reviewed). +C ~~ Reactivity for PAN changed from 4.0 to 16.0 by J. Pleim (07/07) based on +C comparisons with Turnipseed et al., JGR, 2006. +C %% Species ICL1 and ICL2 are removed, not used in CB05. G. Sarwar (07/07) +C <> Hazardous Air Pollutants that are believed to undergo significant dry +C deposition. Hydrazine and triethylamine reactivities are based on analogies +C to NH3. Maleic anhydride reactivity is assumed similar to aldehydes. +C Toluene diisocyanate and hexamethylene diisocyanate reactivities are +C assumed to be similar to SO2. Diffusivities are calculated with standard +C formulas. W. Hutzell (04/08) +C %% G. Sarwar: added data for iodine and bromine species (03/2016) +C %% B. Hutzell: added dry deposition data for methane, acrylic acid, methyl chloride, +C and acetonitrile (09/2016) +C------------------------------------------------------------------------------- + + Use GRID_CONF ! horizontal & vertical domain specifications + Use LSM_MOD ! Land surface data + Use DEPVVARS, Only: ltotg + + Implicit None + + Include SUBST_CONST ! constants + + Type :: MET_Type +!> 2-D meteorological fields: + Real, Allocatable :: RDEPVHT ( :,: ) ! air dens / dep vel ht + Real, Allocatable :: DENS1 ( :,: ) ! layer 1 air density + Real, Allocatable :: PRSFC ( :,: ) ! surface pressure [Pa] + Real, Allocatable :: Q2 ( :,: ) ! 2 meter water vapor mixing ratio [kg/kg] + Real, Allocatable :: QSS_GRND ( :,: ) ! ground saturation water vapor mixing ratio [kg/kg] + Real, Allocatable :: RH ( :,: ) ! relative humidity [ratio] + Real, Allocatable :: RA ( :,: ) ! aerodynamic resistnace [s/m] + Real, Allocatable :: RS ( :,: ) ! stomatal resistnace [s/m] + Real, Allocatable :: RC ( :,: ) ! convective precipitation [cm] + Real, Allocatable :: RN ( :,: ) ! non-convective precipitation [mc] + Real, Allocatable :: RGRND ( :,: ) ! Solar radiation at the ground [W/m**2] + Real, Allocatable :: HFX ( :,: ) ! Sensible heat flux [W/m**2] + Real, Allocatable :: LH ( :,: ) ! Latent heat flux [W/m**2] + Real, Allocatable :: SNOCOV ( :,: ) ! Snow cover [1=yes, 0=no] + Real, Allocatable :: TEMP2 ( :,: ) ! two meter temperature [K] + Real, Allocatable :: TEMPG ( :,: ) ! skin temperature [K] + Real, Allocatable :: TSEASFC ( :,: ) ! SST [K] + Real, Allocatable :: USTAR ( :,: ) ! surface friction velocity [m/s] + Real, Allocatable :: VEG ( :,: ) ! fractional vegetation coverage [ratio] + Real, Allocatable :: LAI ( :,: ) ! grid cell leaf area index [m**2/m**2] + Real, Allocatable :: WR ( :,: ) ! precip intercepted by canopy [m] + Real, Allocatable :: WSPD10 ( :,: ) ! 10-m wind speed [m/s] + Real, Allocatable :: WSTAR ( :,: ) ! convective velocity scale [m/s] + Real, Allocatable :: Z0 ( :,: ) ! roughness length [m] + Real, Allocatable :: SOIM1 ( :,: ) ! 1 cm soil moisture [m**3/m**3] + Real, Allocatable :: SOIM2 ( :,: ) ! 1 m soil moisture [m**3/m**3] + Real, Allocatable :: SOIT1 ( :,: ) ! 1 cm soil temperature [K] + Real, Allocatable :: SOIT2 ( :,: ) ! 1 m soil temperature [K] + Real, Allocatable :: SEAICE ( :,: ) ! Sea ice coverage [%] + Real, Allocatable :: MOL ( :,: ) ! Monin-Obukhov length [m] + Real, Allocatable :: MOLI ( :,: ) ! inverse of Monin-Obukhov length [m] + Real, Allocatable :: HOL ( :,: ) ! PBL over Obukhov length + Real, Allocatable :: XPBL ( :,: ) ! PBL sigma height + Integer, Allocatable :: LPBL ( :,: ) ! PBL layer + Logical, Allocatable :: CONVCT ( :,: ) ! convection flag + Real, Allocatable :: PBL ( :,: ) ! pbl height (m) + Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) + +!> FENGSHA option + Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content + Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content + Real, Allocatable :: DRAG ( :,: ) ! Drag Partion + Real, Allocatable :: UTHR ( :,: ) ! Dry Threshold Friction Velocity + +!> U and V wind components on the cross grid points + Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] + Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] +!> 3-D meteorological fields: + Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s] + Real, Allocatable :: PRES ( :,:,: ) ! layer 1 pressure [Pa] + Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio + Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio + Real, Allocatable :: THETAV ( :,:,: ) ! potential temp + Real, Allocatable :: TA ( :,:,: ) ! temperature (K) + Real, Allocatable :: ZH ( :,:,: ) ! mid-layer height above ground [m] + Real, Allocatable :: ZF ( :,:,: ) ! layer height [m] + Real, Allocatable :: DZF ( :,:,: ) ! layer surface thickness + Real, Allocatable :: DENS ( :,:,: ) ! air density + Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian + Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian + Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian + End Type MET_Type + + Type :: GRID_Type +!> Grid infomation: +!> Vertical information + Real, Allocatable :: DX3F ( : ) ! sigma layer surface thickness ! vdiffacmx.F + Real, Allocatable :: RDX3F ( : ) ! reciprocal sigma layer thickness ! EMIS_DEFN.F, sedi.F, vdiffacmx.F, vdiffproc.F + Real, Allocatable :: RDX3M ( : ) ! reciprocal sigma midlayer thickness ! vdiffproc.F +!> Horizontal Information: + Real, Allocatable :: RMSFX4 ( :,: ) ! inverse map scale factor ** 4 + Real, Allocatable :: LON ( :,: ) ! longitude + Real, Allocatable :: LAT ( :,: ) ! latitude + Real, Allocatable :: LWMASK ( :,: ) ! land water mask + Real, Allocatable :: OCEAN ( :,: ) ! Open ocean + Real, Allocatable :: SZONE ( :,: ) ! Surf zone + Real, Allocatable :: PURB ( :,: ) ! percent urban [%] + Integer, Allocatable :: SLTYP ( :,: ) ! soil type [category] + Real, Allocatable :: WSAT ( :,: ) ! soil wilting point + Real, Allocatable :: WWLT ( :,: ) ! soil wilting point + Real, Allocatable :: BSLP ( :,: ) ! B Slope + Real, Allocatable :: WRES ( :,: ) ! Soil residual moisture point + Real, Allocatable :: WFC ( :,: ) ! soil field capacity +! Real, Allocatable :: RHOB ( :,: ) ! soil bulk density + Real, Allocatable :: LUFRAC ( :,:,: ) ! land use fraction (col,row,lu_type)[ratio] +C Land use information: + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. + End Type GRID_Type + + Type :: MOSAIC_Type ! (col,row,lu) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. +!> Sub grid cell meteorological variables: + Real, Allocatable :: USTAR ( :,:,: ) ! surface friction velocity [m/s] + Real, Allocatable :: LAI ( :,:,: ) ! leaf area index [m**2/m**2] + Real, Allocatable :: VEG ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: Z0 ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: DELTA ( :,:,: ) ! Surface wetness [ratio] +!> Sub grid cell resistances + Real, Allocatable :: RA ( :,:,: ) ! aerodynamic resistance [s/m] + Real, Allocatable :: RSTW ( :,:,: ) ! Stomatal Resistance of water [s/m] + Real, Allocatable :: RINC ( :,:,: ) ! In-canopy resistance [s/m] + End Type MOSAIC_Type + + Type :: ChemMos_Type ! (col,row,lu,spc) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: Lu_Type ( : ) ! general land use type e.g. water, forest, etc. + Character( 16 ), Allocatable :: SubName ( : ) ! Deposition species name +!> Sub grid cell chemically dependent resistances + Real, Allocatable :: Rb ( :,:,:,: ) ! quasi-laminar boundary layer resistance [s/m] + Real, Allocatable :: Rst ( :,:,:,: ) ! stomatal resistance [s/m] + Real, Allocatable :: Rgc ( :,:,:,: ) ! Canopy covered soil resistance [s/m] + Real, Allocatable :: Rgb ( :,:,:,: ) ! Barron soil resistance [s/m] + Real, Allocatable :: Rcut ( :,:,:,: ) ! soil resistance [s/m] + Real, Allocatable :: Rwat ( :,:,:,: ) ! surface water resistance [s/m] +!> Sub grid cell compensation point + Real, Allocatable :: Catm ( :,:,:,: ) ! Atmospheric [ppm] + Real, Allocatable :: CZ0 ( :,:,:,: ) ! compensation point at Z0 [ppm] + Real, Allocatable :: Cleaf( :,:,:,: ) ! Leaf compensation point [ppm] + Real, Allocatable :: Cstom( :,:,:,: ) ! Stomatal compensation point [ppm] + Real, Allocatable :: Ccut ( :,:,:,: ) ! Cuticular compensation point [ppm] + Real, Allocatable :: Csoil( :,:,:,: ) ! Soil compensation point [ppm] + End Type ChemMos_Type + + Type( MET_Type ), Save :: Met_Data + Type( GRID_Type ), Save :: Grid_Data + Type( MOSAIC_Type ), Save :: Mosaic_Data + Type( ChemMos_Type ), Save :: ChemMos_Data + + Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module +!> M3 asx constants + Real, Parameter :: a0 = 8.0 ! [dim'less] + Real, Parameter :: d3 = 1.38564e-2 ! [dim'less] + Real, Parameter :: dwat = 0.2178 ! [cm^2/s] at 273.15K + Real, Parameter :: hplus_ap = 1.0e-6 ! pH=6.0 leaf apoplast solution Ph (Massad et al 2008) + Real, Parameter :: hplus_def = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_east = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_h2o = 7.94328e-9 ! 10.0**(-8.1) + Real, Parameter :: hplus_west = 3.16228e-6 ! 10.0**(-5.5) + Real, Parameter :: kvis = 0.132 ! [cm^2 / s] at 273.15K + Real, Parameter :: pr = 0.709 ! [dim'less] + Real, Parameter :: rcut0 = 3000.0 ! [s/m] + Real, Parameter :: rcw0 = 125000.0 ! acc'd'g to Padro and + Real, Parameter :: resist_max = 1.0e30 ! maximum resistance + Real, Parameter :: rg0 = 1000.0 ! [s/m] + Real, Parameter :: rgwet0 = 25000.0 ! [s/m] + Real, Parameter :: rsndiff = 10.0 ! snow diffusivity fac + Real, Parameter :: rsnow0 = 1000.0 + Real, Parameter :: svp2 = 17.67 ! from MM5 and WRF + Real, Parameter :: svp3 = 29.65 ! from MM5 and WRF + Real, Parameter :: rt25inK = 1.0/(stdtemp + 25.0) ! 298.15K = 25C + Real, Parameter :: twothirds = 2.0 / 3.0 + Real, Parameter :: betah = 5.0 ! WRF 3.6 px uses Dyer + Real, Parameter :: gamah = 16.0 + Real, Parameter :: pr0 = 0.95 + Real, Parameter :: karman = 0.40 + Real, Parameter :: f3min = 0.25 + Real, Parameter :: ftmin = 0.0000001 ! m/s + Real, Parameter :: nscat = 16.0 + Real, Parameter :: rsmax = 5000.0 ! s/m + + Real :: ar ( ltotg ) ! reactivity relative to HNO3 + Real :: dif0 ( ltotg ) ! molecular diffusivity [cm2/s] + Real :: lebas ( ltotg ) ! Le Bas molar volume [cm3/mol ] + Real :: meso ( ltotg ) ! Exception for species that + ! react with cell walls. fo in + ! Wesely 1989 eq 6. + Character( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST + + Logical, Save :: MET_INITIALIZED = .false. + Real, Save :: CONVPA ! Pressure conversion factor file units to Pa + Logical, Save :: MINKZ + Logical, Save :: CSTAGUV ! Winds are available with C stagger? + Logical, Save :: ifwr = .false. + + Public :: INIT_MET + + Logical, Private, Save :: ifsst = .false. + Logical, Private, Save :: ifq2 = .false. + Logical, Private, Save :: rinv = .True. + Logical, Private, Save :: iflh = .false. + + Integer, Private :: C, R, L, S ! loop induction variables + Integer, Private :: SPC + Character( 16 ), Private, Save :: vname_rc, vname_rn, vname_uc, vname_vc + Real, Private, Save :: P0 ! reference pressure (100000.0 Pa) for Potential Temperature, note that in meteorology they do not use the SI 1 ATM. + + Integer, Private, Save :: LOGDEV + Integer, Private, Save :: GXOFF, GYOFF ! global origin offset from file + Integer, Private, Save :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ! MET_CRO_3D + Integer, Private, Save :: STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ! MET_DOT_3D + Integer, Private, Save :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ! MET_CRO_2D + Integer, Private, Save :: STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ! OCEAN_1 + + Real, Pointer, Private :: BUFF1D( : ) ! 1D temp var number of layers + Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var + Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var + +! FENGSHA option control + CHARACTER( 20 ), SAVE :: CTM_FENGSHA = 'CTM_FENGSHA '! env var for in-line + LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option + + INTEGER IOSX ! i/o and allocate memory status + + DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ + DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ + DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ + DATA subname( 4), dif0( 4), ar( 4), meso( 4), lebas( 4) / 'NO ', 0.1802, 2.0, 0.0, 14.0/ + DATA subname( 5), dif0( 5), ar( 5), meso( 5), lebas( 5) / 'O3 ', 0.1444, 12.0, 1.0, 21.0/ + DATA subname( 6), dif0( 6), ar( 6), meso( 6), lebas( 6) / 'HNO3 ', 0.1067, 8000.0, 0.0, 35.0/ + DATA subname( 7), dif0( 7), ar( 7), meso( 7), lebas( 7) / 'H2O2 ', 0.1300,34000.0, 1.0, 28.0/ !ar=34,000 such that r_cut=0.7 s/m as in Nguyen et al. 2015 + DATA subname( 8), dif0( 8), ar( 8), meso( 8), lebas( 8) / 'ACETALDEHYDE ', 0.1111, 10.0, 0.0, 56.0/ + DATA subname( 9), dif0( 9), ar( 9), meso( 9), lebas( 9) / 'FORMALDEHYDE ', 0.1554, 10.0, 0.0, 35.0/ + DATA subname( 10), dif0( 10), ar( 10), meso( 10), lebas( 10) / 'METHYLHYDROPEROX', 0.1179, 10.0, 0.3, 49.0/ !meso change from 0.1 to 0.3, Wolfe and Thornton 2011 ACP per J. Bash + DATA subname( 11), dif0( 11), ar( 11), meso( 11), lebas( 11) / 'PEROXYACETIC_ACI', 0.0868, 20.0, 0.1, 70.0/ + DATA subname( 12), dif0( 12), ar( 12), meso( 12), lebas( 12) / 'ACETIC_ACID ', 0.0944, 20.0, 0.0, 63.0/ + DATA subname( 13), dif0( 13), ar( 13), meso( 13), lebas( 13) / 'NH3 ', 0.1978, 20.0, 0.0, 28.0/ + DATA subname( 14), dif0( 14), ar( 14), meso( 14), lebas( 14) / 'PAN ', 0.0687, 16.0, 0.1, 91.0/ + DATA subname( 15), dif0( 15), ar( 15), meso( 15), lebas( 15) / 'HNO2 ', 0.1349, 20.0, 0.1, 28.0/ + DATA subname( 16), dif0( 16), ar( 16), meso( 16), lebas( 16) / 'CO ', 0.1807, 5.0, 0.0, 14.0/ + DATA subname( 17), dif0( 17), ar( 17), meso( 17), lebas( 17) / 'METHANOL ', 0.1329, 2.0, 0.0, 42.0/ + DATA subname( 18), dif0( 18), ar( 18), meso( 18), lebas( 18) / 'N2O5 ', 0.0808, 5000.0, 0.0, 49.0/ + DATA subname( 19), dif0( 19), ar( 19), meso( 19), lebas( 19) / 'NO3 ', 0.1153, 5000.0, 0.0, 28.0/ + DATA subname( 20), dif0( 20), ar( 20), meso( 20), lebas( 20) / 'GENERIC_ALDEHYDE', 0.0916, 10.0, 0.0, 56.0/ + DATA subname( 21), dif0( 21), ar( 21), meso( 21), lebas( 21) / 'CL2 ', 0.1080, 10.0, 0.0, 49.0/ + DATA subname( 22), dif0( 22), ar( 22), meso( 22), lebas( 22) / 'HOCL ', 0.1300, 10.0, 0.0, 38.5/ + DATA subname( 23), dif0( 23), ar( 23), meso( 23), lebas( 23) / 'HCL ', 0.1510, 8000.0, 0.0, 31.5/ + DATA subname( 24), dif0( 24), ar( 24), meso( 24), lebas( 24) / 'FMCL ', 0.1094, 10.0, 0.0, 45.5/ + DATA subname( 25), dif0( 25), ar( 25), meso( 25), lebas( 25) / 'HG ', 0.1194, 0.1, 0.0, 14.8/ ! lebas not used + DATA subname( 26), dif0( 26), ar( 26), meso( 26), lebas( 26) / 'HGIIGAS ', 0.0976, 8000.0, 0.0, 95.0/ ! estimation from back calculating to get dw25 = 1.04e-5 (Garland et al, 1965) + DATA subname( 27), dif0( 27), ar( 27), meso( 27), lebas( 27) / 'TECDD_2378 ', 0.0525, 2.0, 0.0, 217.0/ + DATA subname( 28), dif0( 28), ar( 28), meso( 28), lebas( 28) / 'PECDD_12378 ', 0.0508, 2.0, 0.0, 234.5/ + DATA subname( 29), dif0( 29), ar( 29), meso( 29), lebas( 29) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 30), dif0( 30), ar( 30), meso( 30), lebas( 30) / 'HXCDD_123678 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 31), dif0( 31), ar( 31), meso( 31), lebas( 31) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 32), dif0( 32), ar( 32), meso( 32), lebas( 32) / 'HPCDD_1234678 ', 0.0480, 2.0, 0.0, 269.5/ + DATA subname( 33), dif0( 33), ar( 33), meso( 33), lebas( 33) / 'OTCDD ', 0.0474, 2.0, 0.0, 287.0/ + DATA subname( 34), dif0( 34), ar( 34), meso( 34), lebas( 34) / 'TECDF_2378 ', 0.0534, 2.0, 0.0, 210.0/ + DATA subname( 35), dif0( 35), ar( 35), meso( 35), lebas( 35) / 'PECDF_12378 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 36), dif0( 36), ar( 36), meso( 36), lebas( 36) / 'PECDF_23478 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 37), dif0( 37), ar( 37), meso( 37), lebas( 37) / 'HXCDF_123478 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 38), dif0( 38), ar( 38), meso( 38), lebas( 38) / 'HXCDF_123678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 39), dif0( 39), ar( 39), meso( 39), lebas( 39) / 'HXCDF_234678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 40), dif0( 40), ar( 40), meso( 40), lebas( 40) / 'HXCDF_123789 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 41), dif0( 41), ar( 41), meso( 41), lebas( 41) / 'HPCDF_1234678 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 42), dif0( 42), ar( 42), meso( 42), lebas( 42) / 'HPCDF_1234789 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 43), dif0( 43), ar( 43), meso( 43), lebas( 43) / 'OTCDF ', 0.0474, 2.0, 0.0, 280.0/ + DATA subname( 44), dif0( 44), ar( 44), meso( 44), lebas( 44) / 'NAPHTHALENE ', 0.0778, 4.0, 0.0, 119.0/ + DATA subname( 45), dif0( 45), ar( 45), meso( 45), lebas( 45) / '1NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 46), dif0( 46), ar( 46), meso( 46), lebas( 46) / '2NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 47), dif0( 47), ar( 47), meso( 47), lebas( 47) / '14NAPHTHOQUINONE', 0.0780, 4.0, 0.0, 119.0/ + DATA subname( 48), dif0( 48), ar( 48), meso( 48), lebas( 48) / 'HEXAMETHYLE_DIIS', 0.0380, 10.0, 0.0, 196.0/ + DATA subname( 49), dif0( 49), ar( 49), meso( 49), lebas( 49) / 'HYDRAZINE ', 0.4164, 20.0, 0.0, 42.0/ + DATA subname( 50), dif0( 50), ar( 50), meso( 50), lebas( 50) / 'MALEIC_ANHYDRIDE', 0.0950, 10.0, 0.0, 70.0/ + DATA subname( 51), dif0( 51), ar( 51), meso( 51), lebas( 51) / '24-TOLUENE_DIIS ', 0.0610, 10.0, 0.0, 154.0/ + DATA subname( 52), dif0( 52), ar( 52), meso( 52), lebas( 52) / 'TRIETHYLAMINE ', 0.0881, 20.0, 0.0, 154.0/ + DATA subname( 53), dif0( 53), ar( 53), meso( 53), lebas( 53) / 'ORG_NTR ', 0.0607, 16.0, 0.0, 160.0/ ! assumes 58.2% C5H11O4N and 41.8% C5H11O3N + DATA subname( 54), dif0( 54), ar( 54), meso( 54), lebas( 54) / 'HYDROXY_NITRATES', 0.0609, 16.0, 0.0, 156.1/ + DATA subname( 55), dif0( 55), ar( 55), meso( 55), lebas( 55) / 'MPAN ', 0.0580, 16.0, 0.1, 133.0/ + DATA subname( 56), dif0( 56), ar( 56), meso( 56), lebas( 56) / 'PPN ', 0.0631, 16.0, 0.1, 118.2/ + DATA subname( 57), dif0( 57), ar( 57), meso( 57), lebas( 57) / 'MVK ', 0.0810, 8.0, 1.0, 88.8/ + DATA subname( 58), dif0( 58), ar( 58), meso( 58), lebas( 58) / 'DINTR ', 0.0617, 16.0, 0.1, 169.8/ + DATA subname( 59), dif0( 59), ar( 59), meso( 59), lebas( 59) / 'NTR_ALK ', 0.0688, 16.0, 0.1, 133.0/ + DATA subname( 60), dif0( 60), ar( 60), meso( 60), lebas( 60) / 'NTR_OH ', 0.0665, 16.0, 0.1, 140.4/ + DATA subname( 61), dif0( 61), ar( 61), meso( 61), lebas( 61) / 'HYDROXY_NITRATES', 0.0646, 16.0, 0.0, 147.8/ + DATA subname( 62), dif0( 62), ar( 62), meso( 62), lebas( 62) / 'PROPNN ', 0.0677, 16.0, 0.0, 133.0/ + DATA subname( 63), dif0( 63), ar( 63), meso( 63), lebas( 63) / 'NITRYL_CHLORIDE ', 0.0888, 8.0, 0.0, 45.5/ ! dif0 estimated following Erickson III et al., JGR, 104, D7, 8347-8372, 1999 + DATA subname( 64), dif0( 64), ar( 64), meso( 64), lebas( 64) / 'ISOPNN ',0.0457, 8.0, 0.0, 206.8/ + DATA subname( 65), dif0( 65), ar( 65), meso( 65), lebas( 65) / 'MTNO3 ',0.0453, 8.0, 0.0, 251.2/ + DATA subname( 66), dif0( 66), ar( 66), meso( 66), lebas( 66) / 'IEPOX ',0.0579, 8.0, 0.0, 110.8/ + DATA subname( 67), dif0( 67), ar( 67), meso( 67), lebas( 67) / 'HACET ',0.1060, 8.0, 0.0, 72.6/ ! dif0 from Nguyen 2015 PNAS + DATA subname( 68), dif0( 68), ar( 68), meso( 68), lebas( 68) / 'SVALK1 ',0.0514, 20.0, 0.0, 280.5/ + DATA subname( 69), dif0( 69), ar( 69), meso( 69), lebas( 69) / 'SVALK2 ',0.0546, 20.0, 0.0, 275.6/ + DATA subname( 70), dif0( 70), ar( 70), meso( 70), lebas( 70) / 'SVBNZ1 ',0.0642, 20.0, 0.0, 134.1/ + DATA subname( 71), dif0( 71), ar( 71), meso( 71), lebas( 71) / 'SVBNZ2 ',0.0726, 20.0, 0.0, 127.5/ + DATA subname( 72), dif0( 72), ar( 72), meso( 72), lebas( 72) / 'SVISO1 ',0.0733, 20.0, 0.0, 126.3/ + DATA subname( 73), dif0( 73), ar( 73), meso( 73), lebas( 73) / 'SVISO2 ',0.0729, 20.0, 0.0, 123.8/ + DATA subname( 74), dif0( 74), ar( 74), meso( 74), lebas( 74) / 'SVPAH1 ',0.0564, 20.0, 0.0, 235.7/ + DATA subname( 75), dif0( 75), ar( 75), meso( 75), lebas( 75) / 'SVPAH2 ',0.0599, 20.0, 0.0, 231.5/ + DATA subname( 76), dif0( 76), ar( 76), meso( 76), lebas( 76) / 'SVSQT ',0.0451, 20.0, 0.0, 346.5/ + DATA subname( 77), dif0( 77), ar( 77), meso( 77), lebas( 77) / 'SVTOL1 ',0.0637, 20.0, 0.0, 153.7/ + DATA subname( 78), dif0( 78), ar( 78), meso( 78), lebas( 78) / 'SVTOL2 ',0.0607, 20.0, 0.0, 194.1/ + DATA subname( 79), dif0( 79), ar( 79), meso( 79), lebas( 79) / 'SVTRP1 ',0.0603, 20.0, 0.0, 194.9/ + DATA subname( 80), dif0( 80), ar( 80), meso( 80), lebas( 80) / 'SVTRP2 ',0.0559, 20.0, 0.0, 218.8/ + DATA subname( 81), dif0( 81), ar( 81), meso( 81), lebas( 81) / 'SVXYL1 ',0.0610, 20.0, 0.0, 154.6/ + DATA subname( 82), dif0( 82), ar( 82), meso( 82), lebas( 82) / 'SVXYL2 ',0.0585, 20.0, 0.0, 194.6/ + DATA subname( 83), dif0( 83), ar( 83), meso( 83), lebas( 83) / 'IO ',0.1002, 8.0, 0.0, 44.4/ + DATA subname( 84), dif0( 84), ar( 84), meso( 84), lebas( 84) / 'OIO ',0.0938, 8.0, 0.0, 51.8/ + DATA subname( 85), dif0( 85), ar( 85), meso( 85), lebas( 85) / 'I2O2 ',0.0732, 8.0, 0.0, 88.8/ + DATA subname( 86), dif0( 86), ar( 86), meso( 86), lebas( 86) / 'I2O3 ',0.0707, 8.0, 0.0, 96.2/ + DATA subname( 87), dif0( 87), ar( 87), meso( 87), lebas( 87) / 'I2O4 ',0.0684, 8.0, 0.0, 103.6/ + DATA subname( 88), dif0( 88), ar( 88), meso( 88), lebas( 88) / 'HI ',0.1045, 8.0, 0.0, 40.7/ + DATA subname( 89), dif0( 89), ar( 89), meso( 89), lebas( 89) / 'HOI ',0.0972, 8.0, 0.0, 48.1/ + DATA subname( 90), dif0( 90), ar( 90), meso( 90), lebas( 90) / 'INO ',0.0882, 8.0, 0.0, 60.9/ + DATA subname( 91), dif0( 91), ar( 91), meso( 91), lebas( 91) / 'INO2 ',0.0883, 20.0, 0.0, 69.2/ + DATA subname( 92), dif0( 92), ar( 92), meso( 92), lebas( 92) / 'IONO2 ',0.0792, 8.0, 0.0, 77.5/ + DATA subname( 93), dif0( 93), ar( 93), meso( 93), lebas( 93) / 'BRO ',0.1144, 1.0, 0.0, 34.4/ + DATA subname( 94), dif0( 94), ar( 94), meso( 94), lebas( 94) / 'HOBR ',0.1101, 1.0, 0.0, 38.1/ + DATA subname( 95), dif0( 95), ar( 95), meso( 95), lebas( 95) / 'HBR ',0.1216, 2.0, 0.0, 30.7/ + DATA subname( 96), dif0( 96), ar( 96), meso( 96), lebas( 96) / 'BRONO2 ',0.0855, 1.0, 0.0, 67.5/ + DATA subname( 97), dif0( 97), ar( 97), meso( 97), lebas( 97) / 'BRNO2 ',0.0909, 1.0, 0.0, 59.2/ + DATA subname( 98), dif0( 98), ar( 98), meso( 98), lebas( 98) / 'BRCL ',0.0966, 1.0, 0.0, 51.6/ + DATA subname( 99), dif0( 99), ar( 99), meso( 99), lebas( 99) / 'DMS ',0.0926, 2.0, 0.0, 77.4/ + DATA subname(100), dif0(100), ar(100), meso(100), lebas(100) / 'MSA ',0.0896, 2.0, 0.0, 77.4/ + DATA subname(101), dif0(101), ar(101), meso(101), lebas(101) / 'METHANE ',0.2107, 2.0, 0.0, 29.6/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + DATA subname(102), dif0(102), ar(102), meso(102), lebas(102) / 'ACRYACID ',0.0908, 2.0, 0.0, 63.2/ + DATA subname(103), dif0(103), ar(103), meso(103), lebas(103) / 'CARBSULFIDE ',0.1240, 5.0, 0.0, 51.5/ + DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ + DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + + CONTAINS + +C======================================================================= + Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use UTILIO_DEFN + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_CONST ! constants + +C Arguments: + Integer, Intent( IN ) :: JDATE, JTIME ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C File variables: + Real, Pointer :: MSFX2 ( :,: ) + Real, Pointer :: SOILCAT ( :,: ) + Real, Pointer :: X3M ( : ) + +C Local variables: + Character( 16 ) :: PNAME = 'INIT_MET' + Character( 16 ) :: VNAME + CHARACTER( 16 ) :: UNITSCK + CHARACTER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C for INTERPX + Integer STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 + Integer V + Integer ALLOCSTAT + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + + If( MET_INITIALIZED )Return + +!> Allocate buffers + ALLOCATE ( BUFF1D( NLAYS ), + & BUFF2D( NCOLS,NROWS ), + & BUFF3D( NCOLS,NROWS,NLAYS ), STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Buffers' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + BUFF1D = 0.0 + BUFF2D = 0.0 + BUFF3D = 0.0 + +!> Allocate shared arrays +!> Met_Data + ALLOCATE( Met_Data%RDEPVHT ( NCOLS,NROWS ), + & Met_Data%DENS1 ( NCOLS,NROWS ), + & Met_Data%PRSFC ( NCOLS,NROWS ), + & Met_Data%Q2 ( NCOLS,NROWS ), + & Met_Data%QSS_GRND ( NCOLS,NROWS ), + & Met_Data%RH ( NCOLS,NROWS ), + & Met_Data%RA ( NCOLS,NROWS ), + & Met_Data%RS ( NCOLS,NROWS ), + & Met_Data%RC ( NCOLS,NROWS ), + & Met_Data%RN ( NCOLS,NROWS ), + & Met_Data%RGRND ( NCOLS,NROWS ), + & Met_Data%HFX ( NCOLS,NROWS ), + & Met_Data%LH ( NCOLS,NROWS ), + & Met_Data%SNOCOV ( NCOLS,NROWS ), + & Met_Data%TEMP2 ( NCOLS,NROWS ), + & Met_Data%TEMPG ( NCOLS,NROWS ), + & Met_Data%TSEASFC ( NCOLS,NROWS ), + & Met_Data%USTAR ( NCOLS,NROWS ), + & Met_Data%VEG ( NCOLS,NROWS ), + & Met_Data%LAI ( NCOLS,NROWS ), + & Met_Data%WR ( NCOLS,NROWS ), + & Met_Data%WSPD10 ( NCOLS,NROWS ), + & Met_Data%WSTAR ( NCOLS,NROWS ), + & Met_Data%Z0 ( NCOLS,NROWS ), + & Met_Data%SOIM1 ( NCOLS,NROWS ), + & Met_Data%SOIT1 ( NCOLS,NROWS ), + & Met_Data%SEAICE ( NCOLS,NROWS ), + & Met_Data%MOL ( NCOLS,NROWS ), + & Met_Data%MOLI ( NCOLS,NROWS ), + & Met_Data%HOL ( NCOLS,NROWS ), + & Met_Data%XPBL ( NCOLS,NROWS ), + & Met_Data%LPBL ( NCOLS,NROWS ), + & Met_Data%CONVCT ( NCOLS,NROWS ), + & Met_Data%PBL ( NCOLS,NROWS ), + & Met_Data%NACL_EMIS( NCOLS,NROWS ), + & Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ), + & Met_Data%PRES ( NCOLS,NROWS,NLAYS ), + & Met_Data%QV ( NCOLS,NROWS,NLAYS ), + & Met_Data%QC ( NCOLS,NROWS,NLAYS ), + & Met_Data%THETAV ( NCOLS,NROWS,NLAYS ), + & Met_Data%TA ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZH ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DENS ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACM ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACF ( NCOLS,NROWS,NLAYS ), + & Met_Data%RRHOJ ( NCOLS,NROWS,NLAYS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%DX3F ( NLAYS ), + & Grid_Data%RDX3F ( NLAYS ), + & Grid_Data%RDX3M ( NLAYS ), + & Grid_Data%RMSFX4 ( NCOLS,NROWS ), + & Grid_Data%LON ( NCOLS,NROWS ), + & Grid_Data%LAT ( NCOLS,NROWS ), + & Grid_Data%LWMASK ( NCOLS,NROWS ), + & Grid_Data%OCEAN ( NCOLS,NROWS ), + & Grid_Data%SZONE ( NCOLS,NROWS ), + & Grid_Data%PURB ( NCOLS,NROWS ), + & Grid_Data%SLTYP ( NCOLS,NROWS ), + & Grid_Data%NAME ( n_lufrac ), + & Grid_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%NAME = name_lu + Grid_Data%LU_Type = cat_lu + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + ALLOCATE( Met_Data%SOIM2 ( NCOLS,NROWS ), + & Met_Data%SOIT2 ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%WSAT ( NCOLS,NROWS ), + & Grid_Data%WWLT ( NCOLS,NROWS ), + & Grid_Data%BSLP ( NCOLS,NROWS ), + & Grid_Data%WRES ( NCOLS,NROWS ), + & Grid_Data%WFC ( NCOLS,NROWS ), + & Grid_Data%LUFRAC ( NCOLS,NROWS,n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%WSAT = 0.0 + Grid_Data%WWLT = 0.0 + Grid_Data%WFC = 0.0 + Grid_Data%WRES = 0.0 + Grid_Data%BSLP = 0.0 + + ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%VEG ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%Z0 ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RSTW ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RINC ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%NAME ( n_lufrac ), + & Mosaic_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Mosaic_Data%USTAR = 0.0 + Mosaic_Data%LAI = 0.0 + Mosaic_Data%DELTA = 0.0 + Mosaic_Data%VEG = 0.0 + Mosaic_Data%Z0 = 0.000001 + Mosaic_Data%RSTW = 0.0 + Mosaic_Data%RINC = 0.0 + Mosaic_Data%NAME = name_lu + Mosaic_Data%LU_Type = cat_lu + + ALLOCATE( ChemMos_Data%Rb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rst ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rcut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgc ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rwat ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%CZ0 ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cleaf ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cstom ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Ccut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Csoil ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%NAME ( n_lufrac ), + & ChemMos_Data%LU_Type ( n_lufrac ), + & ChemMos_Data%Subname ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating chemistry dependent mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + ChemMos_Data%Rb = resist_max + ChemMos_Data%Rst = resist_max + ChemMos_Data%Rcut = resist_max + ChemMos_Data%Rgc = resist_max + ChemMos_Data%Rgb = resist_max + ChemMos_Data%Rwat = resist_max + ChemMos_Data%CZ0 = 0.0 + ChemMos_Data%Cleaf = 0.0 + ChemMos_Data%Cstom = 0.0 + ChemMos_Data%Ccut = 0.0 + ChemMos_Data%Csoil = 0.0 + ChemMos_Data%NAME = name_lu + ChemMos_Data%LU_Type = cat_lu + ChemMos_Data%SubName = subname + End If + +!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc + FENGSHA = ENVYN( 'CTM_FENGSHA', + & 'Flag for in-line fengsha ', + & .FALSE., IOSX ) + + If ( FENGSHA ) Then + ALLOCATE( Met_Data%CLAYF ( NCOLS,NROWS ), + & Met_Data%SANDF ( NCOLS,NROWS ), + & Met_Data%DRAG ( NCOLS,NROWS ), + & Met_Data%UTHR ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Fengsha variables' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + +!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + + If ( .Not. desc3( met_cro_2d ) ) Then + xmsg = 'Could not get ' // MET_CRO_2D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) rinv = .FALSE. ! Ra and Rst are in units s/m + + SPC = INDEX1( 'WR', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifwr = .True. ! canopy wetness is in METCRO2D + + SPC = INDEX1( 'Q2', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifq2 = .True. ! two meter mixing ratio in METCRO2D + + SPC = INDEX1( 'TSEASFC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifsst = .True. ! two meter SST in METCRO2D + + SPC = INDEX1( 'LH', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) iflh = .True. ! LH in METCRO2D + + SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rc = 'RCA' + Else + vname_rc = 'RC' + End If + + SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rn = 'RNA' + Else + vname_rn = 'RN' + End If + + If ( .Not. desc3( met_dot_3d ) ) Then + xmsg = 'Could not get ' // MET_DOT_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'UWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_uc = 'UWINDC' + CSTAGUV = .TRUE. + Else + vname_uc = 'UWIND' + CSTAGUV = .FALSE. + End If + + SPC = INDEX1( 'VWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_vc = 'VWINDC' + Else + vname_vc = 'VWIND' + End If + + If ( .Not. desc3( met_cro_3d ) ) Then + xmsg = 'Could not get ' // MET_CRO_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + V = INDEX1( 'PRES', NVARS3D, VNAME3D ) + If ( V .Ne. 0 ) Then + UNITSCK = UNITS3D( V ) + Else + XMSG = 'Could not get variable PRES from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Select Case (UNITSCK) + Case ( 'PASCAL','pascal','Pascal','PA','pa','Pa' ) + CONVPA = 1.0 + P0 = 100000.0 + Case ( 'MILLIBAR','millibar','Millibar','MB','mb','Mb' ) + CONVPA = 1.0E-02 + P0 = 100000.0 * CONVPA + Case ( 'CENTIBAR','centibar','Centibar','CB','cb','Cb' ) + CONVPA = 1.0E-03 + P0 = 100000.0 * CONVPA + Case Default + XMSG = 'Units incorrect on ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End Select + + MINKZ = .True. ! default + MINKZ = ENVYN( 'KZMIN', 'Kz min on flag', MINKZ, ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Write( LOGDEV,'(5X, A)' ) 'Kz min on flag' + Select Case( ALLOCSTAT ) + Case ( 1 ) + XMSG = 'Environment variable improperly formatted' + Call M3WARN( PNAME, JDATE, JTIME, XMSG ) + Case ( -1 ) + XMSG = 'Environment variable set, but empty ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + Case ( -2 ) + XMSG = 'Environment variable not set ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + End Select + + If ( .Not. MINKZ ) Then + XMSG = 'This run uses Kz0UT, *NOT* KZMIN in subroutine edyintb.' + Write( LOGDEV,'(/5X, A, /)' ) XMSG + End If + +!> Open the met files + + Call SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, + & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) + Call SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + Call SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + Call SUBHFILE ( MET_DOT_3D, GXOFF, GYOFF, + & STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ) + CALL SUBHFILE ( OCEAN_1, GXOFF, GYOFF, + & STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ) +!> Get sigma coordinate variables + X3M => BUFF1D + Do L = 1, NLAYS + Grid_Data%DX3F( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) + Grid_Data%RDX3F( L ) = 1.0 / Grid_Data%DX3F( L ) + X3M( L ) = 0.5 * ( X3FACE_GD( L ) + X3FACE_GD( L-1 ) ) + End Do + Do L = 1, NLAYS - 1 + Grid_Data%RDX3M( L ) = 1.0 / ( X3M( L+1 ) - X3M( L ) ) + End Do + Grid_Data%RDX3M( NLAYS ) = 0.0 +!> nullify pointer + Nullify( X3M ) + +!> reciprical of msfx2**2 +!> assign MSFX2 + MSFX2 => BUFF2D + VNAME = 'MSFX2' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, MSFX2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%RMSFX4 = 1.0 / ( MSFX2**2 ) +!> nullify pointer + Nullify( MSFX2 ) + + VNAME = 'LON' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LON ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LAT' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LWMASK' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LWMASK ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PURB' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%PURB ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + SOILCAT => BUFF2D + VNAME = 'SLTYP' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, SOILCAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%SLTYP = NINT( SOILCAT ) + Nullify( SOILCAT ) + + If ( ABFLUX .Or. MOSAIC ) Then + Do l = 1, n_lufrac + Write( vname,'( "LUFRAC_",I2.2 )' ) l + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LUFRAC( :,:,l ) ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End Do + + Forall( C = 1:MY_NCOLS, R = 1:MY_NROWS, Grid_Data%SLTYP(C,R) .Le. 11 ) + Grid_Data%WSAT( C,R ) = WSAT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WWLT( C,R ) = WWLT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WFC ( C,R ) = WFC ( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WRES( C,R ) = WRES( Grid_Data%SLTYP( C,R ) ) + Grid_Data%BSLP( C,R ) = BSLP( Grid_Data%SLTYP( C,R ) ) + End Forall + End If + +!> Read fractional seawater and surf-zone coverage from the OCEAN file. +!> Store results in the OCEAN and SZONE arrays. + IF ( .NOT. OPEN3( OCEAN_1, FSREAD3, PNAME ) ) THEN + XMSG = 'Open failure for ' // OCEAN_1 + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'OPEN' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%OCEAN ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SURF' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%SZONE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + MET_INITIALIZED = .true. + + Return + End Subroutine INIT_MET + +C======================================================================= + Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + Use UTILIO_DEFN +#ifdef parallel + USE SE_MODULES ! stenex (using SE_COMM_MODULE) +#else + USE NOOP_MODULES ! stenex (using NOOP_COMM_MODULE) +#endif + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_PE_COMM ! PE communication displacement and direction + Include SUBST_CONST ! constants + +C Arguments: + + Integer, Intent( IN ) :: JDATE, JTIME, TSTEP ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C Parameters: + Real, Parameter :: cond_min = 1.0 / resist_max ! minimum conductance [m/s] + Real, Parameter :: KZMAXL = 500.0 ! upper limit for min Kz [m] + Real, Parameter :: KZ0UT = 1.0 ! minimum eddy diffusivity [m**2/sec] KZ0 + Real, Parameter :: KZL = 0.01 ! lowest KZ + Real, Parameter :: KZU = 1.0 ! 2.0 ! highest KZ + Real, Parameter :: EPS = 1.0E-08 ! small number for temperature difference + +C Local variables: + Real FINT + Real CPAIR, LV, QST + Real TMPFX, TMPVTCON, TST, TSTV + Real, Pointer :: Es_Grnd ( :,: ) + Real, Pointer :: Es_Air ( :,: ) + Real, Pointer :: TV ( :,:,: ) + Integer LP + Integer C, R, L ! loop induction variables + + Character( 16 ) :: PNAME = 'GET_MET' + Character( 16 ) :: VNAME + CharactER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C----------------------------------------------------------------------- +C Interpolate file input variables and format for output +C-------------------------------- MET_CRO_3D -------------------------------- + + VNAME = 'ZH' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PRES' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%PRES ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'DENS' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%DENS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + Met_Data%DENS1 = Met_Data%DENS( :,:,1 ) + + VNAME = 'JACOBM' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACM ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACM = 1.0 / Met_Data%RJACM + + VNAME = 'JACOBF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACF = 1.0 / Met_Data%RJACF + + VNAME = 'DENSA_J' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RRHOJ ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RRHOJ = 1.0 / Met_Data%RRHOJ + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%TA ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QV ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QC' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QC ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C-------------------------------- MET_CRO_2D -------------------------------- +C Vegetation and surface vars + VNAME = 'LAI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LAI ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'VEG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%VEG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZRUF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Z0 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If +C FENGSHA + If ( FENGSHA ) Then + write(*,*) 'Read clayfrac' + VNAME = 'CLAYF' + write(*,*) VNAME, PNAME + write(*,*) JDATE, JTIME + write(*,*) STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2 + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%CLAYF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + write(*,*) 'read sandfrac' + VNAME = 'SANDF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%SANDF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + write(*,*) 'read drag' + VNAME = 'DRAG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%DRAG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + write(*,*) 'Read uthr' + VNAME = 'UTHR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%UTHR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If +C Soil vars + VNAME = 'SOIM1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + VNAME = 'SOIM2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SOIT2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'SOIT1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SEAICE' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SEAICE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + +C met vars + + VNAME = 'PRSFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PRSFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RGRND' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RGRND ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SNOCOV' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SNOCOV ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Where( Met_Data%SNOCOV .Lt. 0.0 ) + Met_Data%SNOCOV = 0.0 + End Where + + VNAME = 'TEMP2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMP2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'TEMPG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMPG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'USTAR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%USTAR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'WSPD10' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WSPD10 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'HFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%HFX ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( iflh ) Then + VNAME = 'LH' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else ! for backward compatibility + VNAME = 'QFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'PBL' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PBL ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Met_cro_2D variables that have recently changed due to MCIP or WRF/CMAQ + + If ( .Not. INTERPX( MET_CRO_2D, vname_rn, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RN ) ) Then + XMSG = MSG1 // TRIM( vname_rn ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( .Not. INTERPX( MET_CRO_2D, vname_rc, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RC ) ) Then + XMSG = MSG1 // TRIM( vname_rc ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ifwr ) Then + VNAME = 'WR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + If ( ifsst ) Then + VNAME = 'TSEASFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TSEASFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%TSEASFC = Met_Data%TEMPG + End If + + If ( rinv ) Then + VNAME = 'RADYNI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RA .Gt. cond_min ) + Met_Data%RA = 1.0/Met_Data%RA + Elsewhere + Met_Data%RA = resist_max + End Where + + VNAME = 'RSTOMI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RS .Gt. cond_min ) + Met_Data%RS = 1.0 / Met_Data%RS + Elsewhere + Met_Data%RS = resist_max + End Where + + Else + + VNAME = 'RA' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RS' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + End If + + If ( ifq2 ) Then ! Q2 in METCRO2D + VNAME = 'Q2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Q2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%Q2 = Met_Data%QV( :,:,1 ) + End If + + Es_Grnd => BUFF2D + Where( Met_Data%TEMPG .Lt. stdtemp ) + Es_Grnd = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMPG ) ) + Elsewhere + Es_Grnd = vp0 *Exp( svp2 * ( Met_Data%TEMPG -stdtemp ) / ( Met_Data%TEMPG -svp3 ) ) + End Where + Met_Data%QSS_GRND = Es_Grnd * 0.622 / ( Met_Data%PRSFC - Es_Grnd ) + Nullify( Es_Grnd ) + + Es_Air => BUFF2D + Where( Met_Data%TEMP2 .Lt. stdtemp ) + Es_Air = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMP2 ) ) + Elsewhere + Es_Air = vp0 *Exp( svp2 * ( Met_Data%TEMP2 -stdtemp ) / ( Met_Data%TEMP2 -svp3 ) ) + End Where + Met_Data%RH = Met_Data%Q2 / ( Es_Air * 0.622 / ( Met_Data%PRSFC - Es_Air ) ) * 100.0 + Where( Met_Data%RH .Gt. 100.0 ) + Met_Data%RH = 100.0 + Elsewhere( Met_Data%RH .lt. 0.0 ) + Met_Data%RH = 0.0 + End Where + Nullify( Es_Air ) + +C-------------------------------- MET_DOT_3D -------------------------------- + If ( .Not. INTERPX( MET_DOT_3D, vname_uc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%UWIND ) ) Then + XMSG = MSG1 // TRIM( vname_uc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + If ( .Not. INTERPX( MET_DOT_3D, vname_vc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%VWIND ) ) Then + XMSG = MSG1 // TRIM( vname_vc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + +C get ghost values for wind fields in case of free trop. + CALL SUBST_COMM ( Met_Data%UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) + CALL SUBST_COMM ( Met_Data%VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) + +C-------------------------------- Calculated Variables -------------------------------- + Met_Data%DZF = Met_Data%ZF - EOSHIFT(Met_Data%ZF, Shift = -1, Boundary = 0.0, Dim = 3) + + Met_Data%RDEPVHT = 1.0 / Met_Data%ZF( :,:,1 ) + + IF ( MINKZ ) THEN + Met_Data%KZMIN = KZL + DO L = 1, NLAYS + Where( Met_Data%ZF( :,:,L ) .LE. KZMAXL ) + Met_Data%KZMIN( :,:,L ) = KZL + ( KZU - KZL ) * 0.01 * Grid_data%PURB + End Where + End Do + ELSE + Met_Data%KZMIN = KZ0UT + END IF + + TV => BUFF3D + TV = Met_Data%TA * ( 1.0 + 0.608 * Met_Data%QV ) + Met_Data%THETAV = TV * ( P0 / Met_Data%PRES ) ** 0.286 + Nullify( TV ) + +C------ Updating MOL, then WSTAR, MOLI, HOL + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + ! CPAIR = 1004.67 * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + CPAIR = CPD * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + TMPFX = Met_Data%HFX( C,R ) / ( CPAIR * Met_Data%DENS( C,R,1 ) ) + TMPVTCON = 1.0 + 0.608 * Met_Data%QV( C,R,1 ) ! Conversion factor for virtual temperature + TST = -TMPFX / Met_Data%USTAR( C,R ) + IF ( Met_Data%TA( C,R,1 ) .GT. STDTEMP ) THEN + LV = LV0 - ( 0.00237 * ( Met_Data%TA( C,R,1 ) - STDTEMP ) ) * 1.0E6 + ELSE + LV = 2.83E6 ! Latent heat of sublimation at 0C from Stull (1988) (J/KG) + END IF + QST = -( Met_Data%LH( C,R ) / LV ) + & / ( Met_Data%USTAR( C,R ) * Met_Data%DENS( C,R,1 ) ) + TSTV = TST * TMPVTCON + Met_Data%THETAV( C,R,1 ) * 0.608 * QST + IF ( ABS( TSTV ) .LT. 1.0E-6 ) THEN + TSTV = SIGN( 1.0E-6, TSTV ) + END IF + Met_Data%MOL( C,R ) = Met_Data%THETAV( C,R,1 ) + & * Met_Data%USTAR( C,R ) ** 2 / ( karman * GRAV * TSTV ) + IF ( Met_Data%MOL( C,R ) .LT. 0.0 ) THEN + Met_Data%WSTAR( C,R ) = Met_Data%USTAR( C,R ) * ( Met_Data%PBL( C,R ) + & / ( karman * ABS( Met_Data%MOL( C,R ) ) ) ) ** 0.333333 + ELSE + Met_Data%WSTAR( C,R ) = 0.0 + END IF + + END DO + END DO + + Met_Data%MOLI = 1.0 / Met_Data%MOL + Met_Data%HOL = Met_Data%PBL / Met_Data%MOL +C------ + + Met_Data%CONVCT = .FALSE. + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO L = 1, NLAYS + IF ( Met_Data%PBL( C,R ) .LT. Met_Data%ZF( C,R,L ) ) THEN + LP = L; EXIT + END IF + END DO + + Met_Data%LPBL( C,R ) = LP + If ( LP .Eq. 1 ) Then + FINT = ( Met_Data%PBL( C,R ) ) + & / ( Met_Data%ZF( C,R,LP ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + Else + FINT = ( Met_Data%PBL( C,R ) - Met_Data%ZF( C,R,LP-1 ) ) + & / ( Met_Data%ZF( C,R,LP ) - Met_Data%ZF( C,R,LP-1 ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + End If + END DO + END DO + Where( Met_Data%THETAV( :,:,1 ) - Met_Data%THETAV( :,:,2 ) .Gt. EPS .And. + & Met_Data%HOL .Lt. -0.02 .And. Met_Data%LPBL .Gt. 3 ) + Met_Data%CONVCT = .True. + End Where + + Return + End Subroutine GET_MET + + End Module ASX_DATA_MOD diff --git a/src/model/src/ASX_DATA_MOD.F~ b/src/model/src/ASX_DATA_MOD.F~ new file mode 100755 index 0000000..0e7b79e --- /dev/null +++ b/src/model/src/ASX_DATA_MOD.F~ @@ -0,0 +1,1459 @@ +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module ASX_DATA_MOD + +C----------------------------------------------------------------------- +C Function: User-defined types + +C Revision History: +C 19 Aug 2014 J.Bash: initial implementation +C 17 July 2015 H.Foroutan: Updated the calculation of MOL, MOLI, HOL, and WSTAR +C 25 Aug 2015 H. Pye: Added IEPOX, HACET surrogates +C modified PROPNN and H2O2 +C Increased ar for ozone from 8 to 12. +C Change meso from 0.1 to 0 for some org. nitrates +C Changes based on Nguyen et al. 2015 PNAS and SOAS +C +C---------Notes +C * Updates based on literature review 7/96 JEP +C # Diff and H based on Wesely (1988) same as RADM +C + Estimated by JEP 2/97 +C @ Updated by JEP 9/01 +C ~ Added by YW 1/02. Dif0 based on Massman (1998). Henry's Law constant +C is defined here as: h=cg/ca, where cg is the concentration of a species +C in gas-phase, and ca is its aqueous-phase concentration. The smaller h, +C the larger solubility. Henry's Law constant in another definition (KH): +C KH = ca/pg [M/atm], KH = KH0 * exp(-DKH/R(1/T-1/T0)), where KH0 and -DKH +C values are from Rolf Sander (1999). h=1/(KH*R*T). +C ** Update by DBS based on estimates by JEP 1/03 +C ^^ From Bill Massman, personal communication 4/03 +C ## Diffusivity calculated by SPARC, reactivity = other aldehydes +C ++ Dif0 in Massman is diffusivity at temperature 0C and 1 atm (101.325kPa), so +C chemicals that were not in Massman's paper need to be adjusted. We assume +C JEP's original values were for 25C and 1 atm. +C % Added by G. Sarwar (10/04) +C $ Added by R. Bullock (02/05) HG diffusivity is from Massman (1999). +C HGIIGAS diffusivity calculated from the HG value and a mol. wt. scaling +C factor of MW**(-2/3) from EPA/600/3-87/015. ORD, Athens, GA. HGIIGAS +C mol.wt. used is that of HgCl2. Reactivity of HG is 1/20th of NO and NO2 +C values based on general atmospheric lifetimes of each species. Reactivity +C of HGIIGAS is based on HNO3 surrogate. +C @@ Mesophyll resistances for NO, NO2, and CO added by J. Pleim (07/07) based +C on values in Pleim, Venkatram, and Yamartino, 1984: ADOM/TADAP Model +C Development Program, Volume 4, The Dry Deposition Module. ERT, Inc., +C Concord, MA (peer reviewed). +C ~~ Reactivity for PAN changed from 4.0 to 16.0 by J. Pleim (07/07) based on +C comparisons with Turnipseed et al., JGR, 2006. +C %% Species ICL1 and ICL2 are removed, not used in CB05. G. Sarwar (07/07) +C <> Hazardous Air Pollutants that are believed to undergo significant dry +C deposition. Hydrazine and triethylamine reactivities are based on analogies +C to NH3. Maleic anhydride reactivity is assumed similar to aldehydes. +C Toluene diisocyanate and hexamethylene diisocyanate reactivities are +C assumed to be similar to SO2. Diffusivities are calculated with standard +C formulas. W. Hutzell (04/08) +C %% G. Sarwar: added data for iodine and bromine species (03/2016) +C %% B. Hutzell: added dry deposition data for methane, acrylic acid, methyl chloride, +C and acetonitrile (09/2016) +C------------------------------------------------------------------------------- + + Use GRID_CONF ! horizontal & vertical domain specifications + Use LSM_MOD ! Land surface data + Use DEPVVARS, Only: ltotg + + Implicit None + + Include SUBST_CONST ! constants + + Type :: MET_Type +!> 2-D meteorological fields: + Real, Allocatable :: RDEPVHT ( :,: ) ! air dens / dep vel ht + Real, Allocatable :: DENS1 ( :,: ) ! layer 1 air density + Real, Allocatable :: PRSFC ( :,: ) ! surface pressure [Pa] + Real, Allocatable :: Q2 ( :,: ) ! 2 meter water vapor mixing ratio [kg/kg] + Real, Allocatable :: QSS_GRND ( :,: ) ! ground saturation water vapor mixing ratio [kg/kg] + Real, Allocatable :: RH ( :,: ) ! relative humidity [ratio] + Real, Allocatable :: RA ( :,: ) ! aerodynamic resistnace [s/m] + Real, Allocatable :: RS ( :,: ) ! stomatal resistnace [s/m] + Real, Allocatable :: RC ( :,: ) ! convective precipitation [cm] + Real, Allocatable :: RN ( :,: ) ! non-convective precipitation [mc] + Real, Allocatable :: RGRND ( :,: ) ! Solar radiation at the ground [W/m**2] + Real, Allocatable :: HFX ( :,: ) ! Sensible heat flux [W/m**2] + Real, Allocatable :: LH ( :,: ) ! Latent heat flux [W/m**2] + Real, Allocatable :: SNOCOV ( :,: ) ! Snow cover [1=yes, 0=no] + Real, Allocatable :: TEMP2 ( :,: ) ! two meter temperature [K] + Real, Allocatable :: TEMPG ( :,: ) ! skin temperature [K] + Real, Allocatable :: TSEASFC ( :,: ) ! SST [K] + Real, Allocatable :: USTAR ( :,: ) ! surface friction velocity [m/s] + Real, Allocatable :: VEG ( :,: ) ! fractional vegetation coverage [ratio] + Real, Allocatable :: LAI ( :,: ) ! grid cell leaf area index [m**2/m**2] + Real, Allocatable :: WR ( :,: ) ! precip intercepted by canopy [m] + Real, Allocatable :: WSPD10 ( :,: ) ! 10-m wind speed [m/s] + Real, Allocatable :: WSTAR ( :,: ) ! convective velocity scale [m/s] + Real, Allocatable :: Z0 ( :,: ) ! roughness length [m] + Real, Allocatable :: SOIM1 ( :,: ) ! 1 cm soil moisture [m**3/m**3] + Real, Allocatable :: SOIM2 ( :,: ) ! 1 m soil moisture [m**3/m**3] + Real, Allocatable :: SOIT1 ( :,: ) ! 1 cm soil temperature [K] + Real, Allocatable :: SOIT2 ( :,: ) ! 1 m soil temperature [K] + Real, Allocatable :: SEAICE ( :,: ) ! Sea ice coverage [%] + Real, Allocatable :: MOL ( :,: ) ! Monin-Obukhov length [m] + Real, Allocatable :: MOLI ( :,: ) ! inverse of Monin-Obukhov length [m] + Real, Allocatable :: HOL ( :,: ) ! PBL over Obukhov length + Real, Allocatable :: XPBL ( :,: ) ! PBL sigma height + Integer, Allocatable :: LPBL ( :,: ) ! PBL layer + Logical, Allocatable :: CONVCT ( :,: ) ! convection flag + Real, Allocatable :: PBL ( :,: ) ! pbl height (m) + Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) + +!> FENGSHA option + Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content + Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content + Real, Allocatable :: DRAG ( :,: ) ! Drag Partion + Real, Allocatable :: UTHR ( :,: ) ! Dry Threshold Friction Velocity + +!> U and V wind components on the cross grid points + Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] + Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] +!> 3-D meteorological fields: + Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s] + Real, Allocatable :: PRES ( :,:,: ) ! layer 1 pressure [Pa] + Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio + Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio + Real, Allocatable :: THETAV ( :,:,: ) ! potential temp + Real, Allocatable :: TA ( :,:,: ) ! temperature (K) + Real, Allocatable :: ZH ( :,:,: ) ! mid-layer height above ground [m] + Real, Allocatable :: ZF ( :,:,: ) ! layer height [m] + Real, Allocatable :: DZF ( :,:,: ) ! layer surface thickness + Real, Allocatable :: DENS ( :,:,: ) ! air density + Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian + Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian + Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian + End Type MET_Type + + Type :: GRID_Type +!> Grid infomation: +!> Vertical information + Real, Allocatable :: DX3F ( : ) ! sigma layer surface thickness ! vdiffacmx.F + Real, Allocatable :: RDX3F ( : ) ! reciprocal sigma layer thickness ! EMIS_DEFN.F, sedi.F, vdiffacmx.F, vdiffproc.F + Real, Allocatable :: RDX3M ( : ) ! reciprocal sigma midlayer thickness ! vdiffproc.F +!> Horizontal Information: + Real, Allocatable :: RMSFX4 ( :,: ) ! inverse map scale factor ** 4 + Real, Allocatable :: LON ( :,: ) ! longitude + Real, Allocatable :: LAT ( :,: ) ! latitude + Real, Allocatable :: LWMASK ( :,: ) ! land water mask + Real, Allocatable :: OCEAN ( :,: ) ! Open ocean + Real, Allocatable :: SZONE ( :,: ) ! Surf zone + Real, Allocatable :: PURB ( :,: ) ! percent urban [%] + Integer, Allocatable :: SLTYP ( :,: ) ! soil type [category] + Real, Allocatable :: WSAT ( :,: ) ! soil wilting point + Real, Allocatable :: WWLT ( :,: ) ! soil wilting point + Real, Allocatable :: BSLP ( :,: ) ! B Slope + Real, Allocatable :: WRES ( :,: ) ! Soil residual moisture point + Real, Allocatable :: WFC ( :,: ) ! soil field capacity +! Real, Allocatable :: RHOB ( :,: ) ! soil bulk density + Real, Allocatable :: LUFRAC ( :,:,: ) ! land use fraction (col,row,lu_type)[ratio] +C Land use information: + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. + End Type GRID_Type + + Type :: MOSAIC_Type ! (col,row,lu) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. +!> Sub grid cell meteorological variables: + Real, Allocatable :: USTAR ( :,:,: ) ! surface friction velocity [m/s] + Real, Allocatable :: LAI ( :,:,: ) ! leaf area index [m**2/m**2] + Real, Allocatable :: VEG ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: Z0 ( :,:,: ) ! vegetation fraction [ratio] + Real, Allocatable :: DELTA ( :,:,: ) ! Surface wetness [ratio] +!> Sub grid cell resistances + Real, Allocatable :: RA ( :,:,: ) ! aerodynamic resistance [s/m] + Real, Allocatable :: RSTW ( :,:,: ) ! Stomatal Resistance of water [s/m] + Real, Allocatable :: RINC ( :,:,: ) ! In-canopy resistance [s/m] + End Type MOSAIC_Type + + Type :: ChemMos_Type ! (col,row,lu,spc) + Character( 16 ), Allocatable :: NAME ( : ) ! LU name + Character( 16 ), Allocatable :: Lu_Type ( : ) ! general land use type e.g. water, forest, etc. + Character( 16 ), Allocatable :: SubName ( : ) ! Deposition species name +!> Sub grid cell chemically dependent resistances + Real, Allocatable :: Rb ( :,:,:,: ) ! quasi-laminar boundary layer resistance [s/m] + Real, Allocatable :: Rst ( :,:,:,: ) ! stomatal resistance [s/m] + Real, Allocatable :: Rgc ( :,:,:,: ) ! Canopy covered soil resistance [s/m] + Real, Allocatable :: Rgb ( :,:,:,: ) ! Barron soil resistance [s/m] + Real, Allocatable :: Rcut ( :,:,:,: ) ! soil resistance [s/m] + Real, Allocatable :: Rwat ( :,:,:,: ) ! surface water resistance [s/m] +!> Sub grid cell compensation point + Real, Allocatable :: Catm ( :,:,:,: ) ! Atmospheric [ppm] + Real, Allocatable :: CZ0 ( :,:,:,: ) ! compensation point at Z0 [ppm] + Real, Allocatable :: Cleaf( :,:,:,: ) ! Leaf compensation point [ppm] + Real, Allocatable :: Cstom( :,:,:,: ) ! Stomatal compensation point [ppm] + Real, Allocatable :: Ccut ( :,:,:,: ) ! Cuticular compensation point [ppm] + Real, Allocatable :: Csoil( :,:,:,: ) ! Soil compensation point [ppm] + End Type ChemMos_Type + + Type( MET_Type ), Save :: Met_Data + Type( GRID_Type ), Save :: Grid_Data + Type( MOSAIC_Type ), Save :: Mosaic_Data + Type( ChemMos_Type ), Save :: ChemMos_Data + + Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module +!> M3 asx constants + Real, Parameter :: a0 = 8.0 ! [dim'less] + Real, Parameter :: d3 = 1.38564e-2 ! [dim'less] + Real, Parameter :: dwat = 0.2178 ! [cm^2/s] at 273.15K + Real, Parameter :: hplus_ap = 1.0e-6 ! pH=6.0 leaf apoplast solution Ph (Massad et al 2008) + Real, Parameter :: hplus_def = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_east = 1.0e-5 ! pH=5.0 + Real, Parameter :: hplus_h2o = 7.94328e-9 ! 10.0**(-8.1) + Real, Parameter :: hplus_west = 3.16228e-6 ! 10.0**(-5.5) + Real, Parameter :: kvis = 0.132 ! [cm^2 / s] at 273.15K + Real, Parameter :: pr = 0.709 ! [dim'less] + Real, Parameter :: rcut0 = 3000.0 ! [s/m] + Real, Parameter :: rcw0 = 125000.0 ! acc'd'g to Padro and + Real, Parameter :: resist_max = 1.0e30 ! maximum resistance + Real, Parameter :: rg0 = 1000.0 ! [s/m] + Real, Parameter :: rgwet0 = 25000.0 ! [s/m] + Real, Parameter :: rsndiff = 10.0 ! snow diffusivity fac + Real, Parameter :: rsnow0 = 1000.0 + Real, Parameter :: svp2 = 17.67 ! from MM5 and WRF + Real, Parameter :: svp3 = 29.65 ! from MM5 and WRF + Real, Parameter :: rt25inK = 1.0/(stdtemp + 25.0) ! 298.15K = 25C + Real, Parameter :: twothirds = 2.0 / 3.0 + Real, Parameter :: betah = 5.0 ! WRF 3.6 px uses Dyer + Real, Parameter :: gamah = 16.0 + Real, Parameter :: pr0 = 0.95 + Real, Parameter :: karman = 0.40 + Real, Parameter :: f3min = 0.25 + Real, Parameter :: ftmin = 0.0000001 ! m/s + Real, Parameter :: nscat = 16.0 + Real, Parameter :: rsmax = 5000.0 ! s/m + + Real :: ar ( ltotg ) ! reactivity relative to HNO3 + Real :: dif0 ( ltotg ) ! molecular diffusivity [cm2/s] + Real :: lebas ( ltotg ) ! Le Bas molar volume [cm3/mol ] + Real :: meso ( ltotg ) ! Exception for species that + ! react with cell walls. fo in + ! Wesely 1989 eq 6. + Character( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST + + Logical, Save :: MET_INITIALIZED = .false. + Real, Save :: CONVPA ! Pressure conversion factor file units to Pa + Logical, Save :: MINKZ + Logical, Save :: CSTAGUV ! Winds are available with C stagger? + Logical, Save :: ifwr = .false. + + Public :: INIT_MET + + Logical, Private, Save :: ifsst = .false. + Logical, Private, Save :: ifq2 = .false. + Logical, Private, Save :: rinv = .True. + Logical, Private, Save :: iflh = .false. + + Integer, Private :: C, R, L, S ! loop induction variables + Integer, Private :: SPC + Character( 16 ), Private, Save :: vname_rc, vname_rn, vname_uc, vname_vc + Real, Private, Save :: P0 ! reference pressure (100000.0 Pa) for Potential Temperature, note that in meteorology they do not use the SI 1 ATM. + + Integer, Private, Save :: LOGDEV + Integer, Private, Save :: GXOFF, GYOFF ! global origin offset from file + Integer, Private, Save :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ! MET_CRO_3D + Integer, Private, Save :: STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ! MET_DOT_3D + Integer, Private, Save :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ! MET_CRO_2D + Integer, Private, Save :: STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ! OCEAN_1 + + Real, Pointer, Private :: BUFF1D( : ) ! 1D temp var number of layers + Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var + Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var + +! FENGSHA option control + CHARACTER( 20 ), SAVE :: CTM_FENGSHA = 'CTM_FENGSHA '! env var for in-line + LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option + + INTEGER IOSX ! i/o and allocate memory status + + DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ + DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ + DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ + DATA subname( 4), dif0( 4), ar( 4), meso( 4), lebas( 4) / 'NO ', 0.1802, 2.0, 0.0, 14.0/ + DATA subname( 5), dif0( 5), ar( 5), meso( 5), lebas( 5) / 'O3 ', 0.1444, 12.0, 1.0, 21.0/ + DATA subname( 6), dif0( 6), ar( 6), meso( 6), lebas( 6) / 'HNO3 ', 0.1067, 8000.0, 0.0, 35.0/ + DATA subname( 7), dif0( 7), ar( 7), meso( 7), lebas( 7) / 'H2O2 ', 0.1300,34000.0, 1.0, 28.0/ !ar=34,000 such that r_cut=0.7 s/m as in Nguyen et al. 2015 + DATA subname( 8), dif0( 8), ar( 8), meso( 8), lebas( 8) / 'ACETALDEHYDE ', 0.1111, 10.0, 0.0, 56.0/ + DATA subname( 9), dif0( 9), ar( 9), meso( 9), lebas( 9) / 'FORMALDEHYDE ', 0.1554, 10.0, 0.0, 35.0/ + DATA subname( 10), dif0( 10), ar( 10), meso( 10), lebas( 10) / 'METHYLHYDROPEROX', 0.1179, 10.0, 0.3, 49.0/ !meso change from 0.1 to 0.3, Wolfe and Thornton 2011 ACP per J. Bash + DATA subname( 11), dif0( 11), ar( 11), meso( 11), lebas( 11) / 'PEROXYACETIC_ACI', 0.0868, 20.0, 0.1, 70.0/ + DATA subname( 12), dif0( 12), ar( 12), meso( 12), lebas( 12) / 'ACETIC_ACID ', 0.0944, 20.0, 0.0, 63.0/ + DATA subname( 13), dif0( 13), ar( 13), meso( 13), lebas( 13) / 'NH3 ', 0.1978, 20.0, 0.0, 28.0/ + DATA subname( 14), dif0( 14), ar( 14), meso( 14), lebas( 14) / 'PAN ', 0.0687, 16.0, 0.1, 91.0/ + DATA subname( 15), dif0( 15), ar( 15), meso( 15), lebas( 15) / 'HNO2 ', 0.1349, 20.0, 0.1, 28.0/ + DATA subname( 16), dif0( 16), ar( 16), meso( 16), lebas( 16) / 'CO ', 0.1807, 5.0, 0.0, 14.0/ + DATA subname( 17), dif0( 17), ar( 17), meso( 17), lebas( 17) / 'METHANOL ', 0.1329, 2.0, 0.0, 42.0/ + DATA subname( 18), dif0( 18), ar( 18), meso( 18), lebas( 18) / 'N2O5 ', 0.0808, 5000.0, 0.0, 49.0/ + DATA subname( 19), dif0( 19), ar( 19), meso( 19), lebas( 19) / 'NO3 ', 0.1153, 5000.0, 0.0, 28.0/ + DATA subname( 20), dif0( 20), ar( 20), meso( 20), lebas( 20) / 'GENERIC_ALDEHYDE', 0.0916, 10.0, 0.0, 56.0/ + DATA subname( 21), dif0( 21), ar( 21), meso( 21), lebas( 21) / 'CL2 ', 0.1080, 10.0, 0.0, 49.0/ + DATA subname( 22), dif0( 22), ar( 22), meso( 22), lebas( 22) / 'HOCL ', 0.1300, 10.0, 0.0, 38.5/ + DATA subname( 23), dif0( 23), ar( 23), meso( 23), lebas( 23) / 'HCL ', 0.1510, 8000.0, 0.0, 31.5/ + DATA subname( 24), dif0( 24), ar( 24), meso( 24), lebas( 24) / 'FMCL ', 0.1094, 10.0, 0.0, 45.5/ + DATA subname( 25), dif0( 25), ar( 25), meso( 25), lebas( 25) / 'HG ', 0.1194, 0.1, 0.0, 14.8/ ! lebas not used + DATA subname( 26), dif0( 26), ar( 26), meso( 26), lebas( 26) / 'HGIIGAS ', 0.0976, 8000.0, 0.0, 95.0/ ! estimation from back calculating to get dw25 = 1.04e-5 (Garland et al, 1965) + DATA subname( 27), dif0( 27), ar( 27), meso( 27), lebas( 27) / 'TECDD_2378 ', 0.0525, 2.0, 0.0, 217.0/ + DATA subname( 28), dif0( 28), ar( 28), meso( 28), lebas( 28) / 'PECDD_12378 ', 0.0508, 2.0, 0.0, 234.5/ + DATA subname( 29), dif0( 29), ar( 29), meso( 29), lebas( 29) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 30), dif0( 30), ar( 30), meso( 30), lebas( 30) / 'HXCDD_123678 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 31), dif0( 31), ar( 31), meso( 31), lebas( 31) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ + DATA subname( 32), dif0( 32), ar( 32), meso( 32), lebas( 32) / 'HPCDD_1234678 ', 0.0480, 2.0, 0.0, 269.5/ + DATA subname( 33), dif0( 33), ar( 33), meso( 33), lebas( 33) / 'OTCDD ', 0.0474, 2.0, 0.0, 287.0/ + DATA subname( 34), dif0( 34), ar( 34), meso( 34), lebas( 34) / 'TECDF_2378 ', 0.0534, 2.0, 0.0, 210.0/ + DATA subname( 35), dif0( 35), ar( 35), meso( 35), lebas( 35) / 'PECDF_12378 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 36), dif0( 36), ar( 36), meso( 36), lebas( 36) / 'PECDF_23478 ', 0.0517, 2.0, 0.0, 227.5/ + DATA subname( 37), dif0( 37), ar( 37), meso( 37), lebas( 37) / 'HXCDF_123478 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 38), dif0( 38), ar( 38), meso( 38), lebas( 38) / 'HXCDF_123678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 39), dif0( 39), ar( 39), meso( 39), lebas( 39) / 'HXCDF_234678 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 40), dif0( 40), ar( 40), meso( 40), lebas( 40) / 'HXCDF_123789 ', 0.0512, 2.0, 0.0, 245.0/ + DATA subname( 41), dif0( 41), ar( 41), meso( 41), lebas( 41) / 'HPCDF_1234678 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 42), dif0( 42), ar( 42), meso( 42), lebas( 42) / 'HPCDF_1234789 ', 0.0487, 2.0, 0.0, 262.5/ + DATA subname( 43), dif0( 43), ar( 43), meso( 43), lebas( 43) / 'OTCDF ', 0.0474, 2.0, 0.0, 280.0/ + DATA subname( 44), dif0( 44), ar( 44), meso( 44), lebas( 44) / 'NAPHTHALENE ', 0.0778, 4.0, 0.0, 119.0/ + DATA subname( 45), dif0( 45), ar( 45), meso( 45), lebas( 45) / '1NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 46), dif0( 46), ar( 46), meso( 46), lebas( 46) / '2NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ + DATA subname( 47), dif0( 47), ar( 47), meso( 47), lebas( 47) / '14NAPHTHOQUINONE', 0.0780, 4.0, 0.0, 119.0/ + DATA subname( 48), dif0( 48), ar( 48), meso( 48), lebas( 48) / 'HEXAMETHYLE_DIIS', 0.0380, 10.0, 0.0, 196.0/ + DATA subname( 49), dif0( 49), ar( 49), meso( 49), lebas( 49) / 'HYDRAZINE ', 0.4164, 20.0, 0.0, 42.0/ + DATA subname( 50), dif0( 50), ar( 50), meso( 50), lebas( 50) / 'MALEIC_ANHYDRIDE', 0.0950, 10.0, 0.0, 70.0/ + DATA subname( 51), dif0( 51), ar( 51), meso( 51), lebas( 51) / '24-TOLUENE_DIIS ', 0.0610, 10.0, 0.0, 154.0/ + DATA subname( 52), dif0( 52), ar( 52), meso( 52), lebas( 52) / 'TRIETHYLAMINE ', 0.0881, 20.0, 0.0, 154.0/ + DATA subname( 53), dif0( 53), ar( 53), meso( 53), lebas( 53) / 'ORG_NTR ', 0.0607, 16.0, 0.0, 160.0/ ! assumes 58.2% C5H11O4N and 41.8% C5H11O3N + DATA subname( 54), dif0( 54), ar( 54), meso( 54), lebas( 54) / 'HYDROXY_NITRATES', 0.0609, 16.0, 0.0, 156.1/ + DATA subname( 55), dif0( 55), ar( 55), meso( 55), lebas( 55) / 'MPAN ', 0.0580, 16.0, 0.1, 133.0/ + DATA subname( 56), dif0( 56), ar( 56), meso( 56), lebas( 56) / 'PPN ', 0.0631, 16.0, 0.1, 118.2/ + DATA subname( 57), dif0( 57), ar( 57), meso( 57), lebas( 57) / 'MVK ', 0.0810, 8.0, 1.0, 88.8/ + DATA subname( 58), dif0( 58), ar( 58), meso( 58), lebas( 58) / 'DINTR ', 0.0617, 16.0, 0.1, 169.8/ + DATA subname( 59), dif0( 59), ar( 59), meso( 59), lebas( 59) / 'NTR_ALK ', 0.0688, 16.0, 0.1, 133.0/ + DATA subname( 60), dif0( 60), ar( 60), meso( 60), lebas( 60) / 'NTR_OH ', 0.0665, 16.0, 0.1, 140.4/ + DATA subname( 61), dif0( 61), ar( 61), meso( 61), lebas( 61) / 'HYDROXY_NITRATES', 0.0646, 16.0, 0.0, 147.8/ + DATA subname( 62), dif0( 62), ar( 62), meso( 62), lebas( 62) / 'PROPNN ', 0.0677, 16.0, 0.0, 133.0/ + DATA subname( 63), dif0( 63), ar( 63), meso( 63), lebas( 63) / 'NITRYL_CHLORIDE ', 0.0888, 8.0, 0.0, 45.5/ ! dif0 estimated following Erickson III et al., JGR, 104, D7, 8347-8372, 1999 + DATA subname( 64), dif0( 64), ar( 64), meso( 64), lebas( 64) / 'ISOPNN ',0.0457, 8.0, 0.0, 206.8/ + DATA subname( 65), dif0( 65), ar( 65), meso( 65), lebas( 65) / 'MTNO3 ',0.0453, 8.0, 0.0, 251.2/ + DATA subname( 66), dif0( 66), ar( 66), meso( 66), lebas( 66) / 'IEPOX ',0.0579, 8.0, 0.0, 110.8/ + DATA subname( 67), dif0( 67), ar( 67), meso( 67), lebas( 67) / 'HACET ',0.1060, 8.0, 0.0, 72.6/ ! dif0 from Nguyen 2015 PNAS + DATA subname( 68), dif0( 68), ar( 68), meso( 68), lebas( 68) / 'SVALK1 ',0.0514, 20.0, 0.0, 280.5/ + DATA subname( 69), dif0( 69), ar( 69), meso( 69), lebas( 69) / 'SVALK2 ',0.0546, 20.0, 0.0, 275.6/ + DATA subname( 70), dif0( 70), ar( 70), meso( 70), lebas( 70) / 'SVBNZ1 ',0.0642, 20.0, 0.0, 134.1/ + DATA subname( 71), dif0( 71), ar( 71), meso( 71), lebas( 71) / 'SVBNZ2 ',0.0726, 20.0, 0.0, 127.5/ + DATA subname( 72), dif0( 72), ar( 72), meso( 72), lebas( 72) / 'SVISO1 ',0.0733, 20.0, 0.0, 126.3/ + DATA subname( 73), dif0( 73), ar( 73), meso( 73), lebas( 73) / 'SVISO2 ',0.0729, 20.0, 0.0, 123.8/ + DATA subname( 74), dif0( 74), ar( 74), meso( 74), lebas( 74) / 'SVPAH1 ',0.0564, 20.0, 0.0, 235.7/ + DATA subname( 75), dif0( 75), ar( 75), meso( 75), lebas( 75) / 'SVPAH2 ',0.0599, 20.0, 0.0, 231.5/ + DATA subname( 76), dif0( 76), ar( 76), meso( 76), lebas( 76) / 'SVSQT ',0.0451, 20.0, 0.0, 346.5/ + DATA subname( 77), dif0( 77), ar( 77), meso( 77), lebas( 77) / 'SVTOL1 ',0.0637, 20.0, 0.0, 153.7/ + DATA subname( 78), dif0( 78), ar( 78), meso( 78), lebas( 78) / 'SVTOL2 ',0.0607, 20.0, 0.0, 194.1/ + DATA subname( 79), dif0( 79), ar( 79), meso( 79), lebas( 79) / 'SVTRP1 ',0.0603, 20.0, 0.0, 194.9/ + DATA subname( 80), dif0( 80), ar( 80), meso( 80), lebas( 80) / 'SVTRP2 ',0.0559, 20.0, 0.0, 218.8/ + DATA subname( 81), dif0( 81), ar( 81), meso( 81), lebas( 81) / 'SVXYL1 ',0.0610, 20.0, 0.0, 154.6/ + DATA subname( 82), dif0( 82), ar( 82), meso( 82), lebas( 82) / 'SVXYL2 ',0.0585, 20.0, 0.0, 194.6/ + DATA subname( 83), dif0( 83), ar( 83), meso( 83), lebas( 83) / 'IO ',0.1002, 8.0, 0.0, 44.4/ + DATA subname( 84), dif0( 84), ar( 84), meso( 84), lebas( 84) / 'OIO ',0.0938, 8.0, 0.0, 51.8/ + DATA subname( 85), dif0( 85), ar( 85), meso( 85), lebas( 85) / 'I2O2 ',0.0732, 8.0, 0.0, 88.8/ + DATA subname( 86), dif0( 86), ar( 86), meso( 86), lebas( 86) / 'I2O3 ',0.0707, 8.0, 0.0, 96.2/ + DATA subname( 87), dif0( 87), ar( 87), meso( 87), lebas( 87) / 'I2O4 ',0.0684, 8.0, 0.0, 103.6/ + DATA subname( 88), dif0( 88), ar( 88), meso( 88), lebas( 88) / 'HI ',0.1045, 8.0, 0.0, 40.7/ + DATA subname( 89), dif0( 89), ar( 89), meso( 89), lebas( 89) / 'HOI ',0.0972, 8.0, 0.0, 48.1/ + DATA subname( 90), dif0( 90), ar( 90), meso( 90), lebas( 90) / 'INO ',0.0882, 8.0, 0.0, 60.9/ + DATA subname( 91), dif0( 91), ar( 91), meso( 91), lebas( 91) / 'INO2 ',0.0883, 20.0, 0.0, 69.2/ + DATA subname( 92), dif0( 92), ar( 92), meso( 92), lebas( 92) / 'IONO2 ',0.0792, 8.0, 0.0, 77.5/ + DATA subname( 93), dif0( 93), ar( 93), meso( 93), lebas( 93) / 'BRO ',0.1144, 1.0, 0.0, 34.4/ + DATA subname( 94), dif0( 94), ar( 94), meso( 94), lebas( 94) / 'HOBR ',0.1101, 1.0, 0.0, 38.1/ + DATA subname( 95), dif0( 95), ar( 95), meso( 95), lebas( 95) / 'HBR ',0.1216, 2.0, 0.0, 30.7/ + DATA subname( 96), dif0( 96), ar( 96), meso( 96), lebas( 96) / 'BRONO2 ',0.0855, 1.0, 0.0, 67.5/ + DATA subname( 97), dif0( 97), ar( 97), meso( 97), lebas( 97) / 'BRNO2 ',0.0909, 1.0, 0.0, 59.2/ + DATA subname( 98), dif0( 98), ar( 98), meso( 98), lebas( 98) / 'BRCL ',0.0966, 1.0, 0.0, 51.6/ + DATA subname( 99), dif0( 99), ar( 99), meso( 99), lebas( 99) / 'DMS ',0.0926, 2.0, 0.0, 77.4/ + DATA subname(100), dif0(100), ar(100), meso(100), lebas(100) / 'MSA ',0.0896, 2.0, 0.0, 77.4/ + DATA subname(101), dif0(101), ar(101), meso(101), lebas(101) / 'METHANE ',0.2107, 2.0, 0.0, 29.6/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + DATA subname(102), dif0(102), ar(102), meso(102), lebas(102) / 'ACRYACID ',0.0908, 2.0, 0.0, 63.2/ + DATA subname(103), dif0(103), ar(103), meso(103), lebas(103) / 'CARBSULFIDE ',0.1240, 5.0, 0.0, 51.5/ + DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ + DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. + + CONTAINS + +C======================================================================= + Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use UTILIO_DEFN + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_CONST ! constants + +C Arguments: + Integer, Intent( IN ) :: JDATE, JTIME ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C File variables: + Real, Pointer :: MSFX2 ( :,: ) + Real, Pointer :: SOILCAT ( :,: ) + Real, Pointer :: X3M ( : ) + +C Local variables: + Character( 16 ) :: PNAME = 'INIT_MET' + Character( 16 ) :: VNAME + CHARACTER( 16 ) :: UNITSCK + CHARACTER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C for INTERPX + Integer STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 + Integer V + Integer ALLOCSTAT + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + + If( MET_INITIALIZED )Return + +!> Allocate buffers + ALLOCATE ( BUFF1D( NLAYS ), + & BUFF2D( NCOLS,NROWS ), + & BUFF3D( NCOLS,NROWS,NLAYS ), STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Buffers' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + BUFF1D = 0.0 + BUFF2D = 0.0 + BUFF3D = 0.0 + +!> Allocate shared arrays +!> Met_Data + ALLOCATE( Met_Data%RDEPVHT ( NCOLS,NROWS ), + & Met_Data%DENS1 ( NCOLS,NROWS ), + & Met_Data%PRSFC ( NCOLS,NROWS ), + & Met_Data%Q2 ( NCOLS,NROWS ), + & Met_Data%QSS_GRND ( NCOLS,NROWS ), + & Met_Data%RH ( NCOLS,NROWS ), + & Met_Data%RA ( NCOLS,NROWS ), + & Met_Data%RS ( NCOLS,NROWS ), + & Met_Data%RC ( NCOLS,NROWS ), + & Met_Data%RN ( NCOLS,NROWS ), + & Met_Data%RGRND ( NCOLS,NROWS ), + & Met_Data%HFX ( NCOLS,NROWS ), + & Met_Data%LH ( NCOLS,NROWS ), + & Met_Data%SNOCOV ( NCOLS,NROWS ), + & Met_Data%TEMP2 ( NCOLS,NROWS ), + & Met_Data%TEMPG ( NCOLS,NROWS ), + & Met_Data%TSEASFC ( NCOLS,NROWS ), + & Met_Data%USTAR ( NCOLS,NROWS ), + & Met_Data%VEG ( NCOLS,NROWS ), + & Met_Data%LAI ( NCOLS,NROWS ), + & Met_Data%WR ( NCOLS,NROWS ), + & Met_Data%WSPD10 ( NCOLS,NROWS ), + & Met_Data%WSTAR ( NCOLS,NROWS ), + & Met_Data%Z0 ( NCOLS,NROWS ), + & Met_Data%SOIM1 ( NCOLS,NROWS ), + & Met_Data%SOIT1 ( NCOLS,NROWS ), + & Met_Data%SEAICE ( NCOLS,NROWS ), + & Met_Data%MOL ( NCOLS,NROWS ), + & Met_Data%MOLI ( NCOLS,NROWS ), + & Met_Data%HOL ( NCOLS,NROWS ), + & Met_Data%XPBL ( NCOLS,NROWS ), + & Met_Data%LPBL ( NCOLS,NROWS ), + & Met_Data%CONVCT ( NCOLS,NROWS ), + & Met_Data%PBL ( NCOLS,NROWS ), + & Met_Data%NACL_EMIS( NCOLS,NROWS ), + & Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ), + & Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ), + & Met_Data%PRES ( NCOLS,NROWS,NLAYS ), + & Met_Data%QV ( NCOLS,NROWS,NLAYS ), + & Met_Data%QC ( NCOLS,NROWS,NLAYS ), + & Met_Data%THETAV ( NCOLS,NROWS,NLAYS ), + & Met_Data%TA ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZH ( NCOLS,NROWS,NLAYS ), + & Met_Data%ZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DZF ( NCOLS,NROWS,NLAYS ), + & Met_Data%DENS ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACM ( NCOLS,NROWS,NLAYS ), + & Met_Data%RJACF ( NCOLS,NROWS,NLAYS ), + & Met_Data%RRHOJ ( NCOLS,NROWS,NLAYS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%DX3F ( NLAYS ), + & Grid_Data%RDX3F ( NLAYS ), + & Grid_Data%RDX3M ( NLAYS ), + & Grid_Data%RMSFX4 ( NCOLS,NROWS ), + & Grid_Data%LON ( NCOLS,NROWS ), + & Grid_Data%LAT ( NCOLS,NROWS ), + & Grid_Data%LWMASK ( NCOLS,NROWS ), + & Grid_Data%OCEAN ( NCOLS,NROWS ), + & Grid_Data%SZONE ( NCOLS,NROWS ), + & Grid_Data%PURB ( NCOLS,NROWS ), + & Grid_Data%SLTYP ( NCOLS,NROWS ), + & Grid_Data%NAME ( n_lufrac ), + & Grid_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%NAME = name_lu + Grid_Data%LU_Type = cat_lu + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + ALLOCATE( Met_Data%SOIM2 ( NCOLS,NROWS ), + & Met_Data%SOIT2 ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic met vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + ALLOCATE( Grid_Data%WSAT ( NCOLS,NROWS ), + & Grid_Data%WWLT ( NCOLS,NROWS ), + & Grid_Data%BSLP ( NCOLS,NROWS ), + & Grid_Data%WRES ( NCOLS,NROWS ), + & Grid_Data%WFC ( NCOLS,NROWS ), + & Grid_Data%LUFRAC ( NCOLS,NROWS,n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic grid vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Grid_Data%WSAT = 0.0 + Grid_Data%WWLT = 0.0 + Grid_Data%WFC = 0.0 + Grid_Data%WRES = 0.0 + Grid_Data%BSLP = 0.0 + + ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%VEG ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%Z0 ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RA ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RSTW ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%RINC ( NCOLS,NROWS,n_lufrac ), + & Mosaic_Data%NAME ( n_lufrac ), + & Mosaic_Data%LU_Type ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Mosaic_Data%USTAR = 0.0 + Mosaic_Data%LAI = 0.0 + Mosaic_Data%DELTA = 0.0 + Mosaic_Data%VEG = 0.0 + Mosaic_Data%Z0 = 0.000001 + Mosaic_Data%RSTW = 0.0 + Mosaic_Data%RINC = 0.0 + Mosaic_Data%NAME = name_lu + Mosaic_Data%LU_Type = cat_lu + + ALLOCATE( ChemMos_Data%Rb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rst ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rcut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgc ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rgb ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Rwat ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%CZ0 ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cleaf ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Cstom ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Ccut ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%Csoil ( NCOLS,NROWS,n_lufrac,ltotg ), + & ChemMos_Data%NAME ( n_lufrac ), + & ChemMos_Data%LU_Type ( n_lufrac ), + & ChemMos_Data%Subname ( n_lufrac ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating chemistry dependent mosaic vars' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + ChemMos_Data%Rb = resist_max + ChemMos_Data%Rst = resist_max + ChemMos_Data%Rcut = resist_max + ChemMos_Data%Rgc = resist_max + ChemMos_Data%Rgb = resist_max + ChemMos_Data%Rwat = resist_max + ChemMos_Data%CZ0 = 0.0 + ChemMos_Data%Cleaf = 0.0 + ChemMos_Data%Cstom = 0.0 + ChemMos_Data%Ccut = 0.0 + ChemMos_Data%Csoil = 0.0 + ChemMos_Data%NAME = name_lu + ChemMos_Data%LU_Type = cat_lu + ChemMos_Data%SubName = subname + End If + +!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc + FENGSHA = ENVYN( 'CTM_FENGSHA', + & 'Flag for in-line fengsha ', + & .FALSE., IOSX ) + + If ( FENGSHA ) Then + ALLOCATE( Met_Data%CLAYF ( NCOLS,NROWS ), + & Met_Data%SANDF ( NCOLS,NROWS ), + & Met_Data%DRAG ( NCOLS,NROWS ), + & Met_Data%UTHR ( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Then + XMSG = 'Failure allocating Fengsha variables' + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + +!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + + If ( .Not. desc3( met_cro_2d ) ) Then + xmsg = 'Could not get ' // MET_CRO_2D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) rinv = .FALSE. ! Ra and Rst are in units s/m + + SPC = INDEX1( 'WR', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifwr = .True. ! canopy wetness is in METCRO2D + + SPC = INDEX1( 'Q2', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifq2 = .True. ! two meter mixing ratio in METCRO2D + + SPC = INDEX1( 'TSEASFC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) ifsst = .True. ! two meter SST in METCRO2D + + SPC = INDEX1( 'LH', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) iflh = .True. ! LH in METCRO2D + + SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rc = 'RCA' + Else + vname_rc = 'RC' + End If + + SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_rn = 'RNA' + Else + vname_rn = 'RN' + End If + + If ( .Not. desc3( met_dot_3d ) ) Then + xmsg = 'Could not get ' // MET_DOT_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + SPC = INDEX1( 'UWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_uc = 'UWINDC' + CSTAGUV = .TRUE. + Else + vname_uc = 'UWIND' + CSTAGUV = .FALSE. + End If + + SPC = INDEX1( 'VWINDC', NVARS3D, VNAME3D ) + If (SPC .Gt. 0) Then + vname_vc = 'VWINDC' + Else + vname_vc = 'VWIND' + End If + + If ( .Not. desc3( met_cro_3d ) ) Then + xmsg = 'Could not get ' // MET_CRO_3D // ' file description' + Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) + End If + + V = INDEX1( 'PRES', NVARS3D, VNAME3D ) + If ( V .Ne. 0 ) Then + UNITSCK = UNITS3D( V ) + Else + XMSG = 'Could not get variable PRES from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Select Case (UNITSCK) + Case ( 'PASCAL','pascal','Pascal','PA','pa','Pa' ) + CONVPA = 1.0 + P0 = 100000.0 + Case ( 'MILLIBAR','millibar','Millibar','MB','mb','Mb' ) + CONVPA = 1.0E-02 + P0 = 100000.0 * CONVPA + Case ( 'CENTIBAR','centibar','Centibar','CB','cb','Cb' ) + CONVPA = 1.0E-03 + P0 = 100000.0 * CONVPA + Case Default + XMSG = 'Units incorrect on ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End Select + + MINKZ = .True. ! default + MINKZ = ENVYN( 'KZMIN', 'Kz min on flag', MINKZ, ALLOCSTAT ) + If ( ALLOCSTAT .Ne. 0 ) Write( LOGDEV,'(5X, A)' ) 'Kz min on flag' + Select Case( ALLOCSTAT ) + Case ( 1 ) + XMSG = 'Environment variable improperly formatted' + Call M3WARN( PNAME, JDATE, JTIME, XMSG ) + Case ( -1 ) + XMSG = 'Environment variable set, but empty ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + Case ( -2 ) + XMSG = 'Environment variable not set ... Using default:' + Write( LOGDEV,'(5X, A)' ) XMSG + End Select + + If ( .Not. MINKZ ) Then + XMSG = 'This run uses Kz0UT, *NOT* KZMIN in subroutine edyintb.' + Write( LOGDEV,'(/5X, A, /)' ) XMSG + End If + +!> Open the met files + + Call SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, + & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) + Call SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + Call SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + Call SUBHFILE ( MET_DOT_3D, GXOFF, GYOFF, + & STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ) + CALL SUBHFILE ( OCEAN_1, GXOFF, GYOFF, + & STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ) +!> Get sigma coordinate variables + X3M => BUFF1D + Do L = 1, NLAYS + Grid_Data%DX3F( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) + Grid_Data%RDX3F( L ) = 1.0 / Grid_Data%DX3F( L ) + X3M( L ) = 0.5 * ( X3FACE_GD( L ) + X3FACE_GD( L-1 ) ) + End Do + Do L = 1, NLAYS - 1 + Grid_Data%RDX3M( L ) = 1.0 / ( X3M( L+1 ) - X3M( L ) ) + End Do + Grid_Data%RDX3M( NLAYS ) = 0.0 +!> nullify pointer + Nullify( X3M ) + +!> reciprical of msfx2**2 +!> assign MSFX2 + MSFX2 => BUFF2D + VNAME = 'MSFX2' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, MSFX2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%RMSFX4 = 1.0 / ( MSFX2**2 ) +!> nullify pointer + Nullify( MSFX2 ) + + VNAME = 'LON' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LON ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LAT' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'LWMASK' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LWMASK ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PURB' + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%PURB ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + SOILCAT => BUFF2D + VNAME = 'SLTYP' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, SOILCAT ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Grid_Data%SLTYP = NINT( SOILCAT ) + Nullify( SOILCAT ) + + If ( ABFLUX .Or. MOSAIC ) Then + Do l = 1, n_lufrac + Write( vname,'( "LUFRAC_",I2.2 )' ) l + If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, + & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, + & JDATE, JTIME, Grid_Data%LUFRAC( :,:,l ) ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End Do + + Forall( C = 1:MY_NCOLS, R = 1:MY_NROWS, Grid_Data%SLTYP(C,R) .Le. 11 ) + Grid_Data%WSAT( C,R ) = WSAT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WWLT( C,R ) = WWLT( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WFC ( C,R ) = WFC ( Grid_Data%SLTYP( C,R ) ) + Grid_Data%WRES( C,R ) = WRES( Grid_Data%SLTYP( C,R ) ) + Grid_Data%BSLP( C,R ) = BSLP( Grid_Data%SLTYP( C,R ) ) + End Forall + End If + +!> Read fractional seawater and surf-zone coverage from the OCEAN file. +!> Store results in the OCEAN and SZONE arrays. + IF ( .NOT. OPEN3( OCEAN_1, FSREAD3, PNAME ) ) THEN + XMSG = 'Open failure for ' // OCEAN_1 + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'OPEN' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%OCEAN ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SURF' + If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, + & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, + & 1,1,JDATE, JTIME, Grid_Data%SZONE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + MET_INITIALIZED = .true. + + Return + End Subroutine INIT_MET + +C======================================================================= + Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) + +C----------------------------------------------------------------------- +C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; +C allocatable RDEPVHT, RJACM, RRHOJ +C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and +C mid-layer +C Tanya took JACOBF out of METCRO3D! Improvise +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + Use UTILIO_DEFN +#ifdef parallel + USE SE_MODULES ! stenex (using SE_COMM_MODULE) +#else + USE NOOP_MODULES ! stenex (using NOOP_COMM_MODULE) +#endif + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + Include SUBST_PE_COMM ! PE communication displacement and direction + Include SUBST_CONST ! constants + +C Arguments: + + Integer, Intent( IN ) :: JDATE, JTIME, TSTEP ! internal simulation date&time + Logical, Intent( IN ) :: MOSAIC + Logical, Intent( IN ) :: ABFLUX + Logical, Intent( IN ) :: HGBIDI + +C Parameters: + Real, Parameter :: cond_min = 1.0 / resist_max ! minimum conductance [m/s] + Real, Parameter :: KZMAXL = 500.0 ! upper limit for min Kz [m] + Real, Parameter :: KZ0UT = 1.0 ! minimum eddy diffusivity [m**2/sec] KZ0 + Real, Parameter :: KZL = 0.01 ! lowest KZ + Real, Parameter :: KZU = 1.0 ! 2.0 ! highest KZ + Real, Parameter :: EPS = 1.0E-08 ! small number for temperature difference + +C Local variables: + Real FINT + Real CPAIR, LV, QST + Real TMPFX, TMPVTCON, TST, TSTV + Real, Pointer :: Es_Grnd ( :,: ) + Real, Pointer :: Es_Air ( :,: ) + Real, Pointer :: TV ( :,:,: ) + Integer LP + Integer C, R, L ! loop induction variables + + Character( 16 ) :: PNAME = 'GET_MET' + Character( 16 ) :: VNAME + CharactER( 30 ) :: MSG1 = ' Error interpolating variable ' + Character( 96 ) :: XMSG = ' ' + +C----------------------------------------------------------------------- +C Interpolate file input variables and format for output +C-------------------------------- MET_CRO_3D -------------------------------- + + VNAME = 'ZH' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'PRES' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%PRES ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%ZF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'DENS' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%DENS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + Met_Data%DENS1 = Met_Data%DENS( :,:,1 ) + + VNAME = 'JACOBM' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACM ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACM = 1.0 / Met_Data%RJACM + + VNAME = 'JACOBF' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RJACF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RJACF = 1.0 / Met_Data%RJACF + + VNAME = 'DENSA_J' + If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%RRHOJ ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Met_Data%RRHOJ = 1.0 / Met_Data%RRHOJ + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%TA ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QV ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'QC' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & JDATE, JTIME, Met_Data%QC ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C-------------------------------- MET_CRO_2D -------------------------------- +C Vegetation and surface vars + VNAME = 'LAI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LAI ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'VEG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%VEG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'ZRUF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Z0 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If +C FENGSHA vars + If ( FENGSHA ) Then + write(*,*) 'Read clayfrac' + VNAME = 'CLAYF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%CLAYF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + write(*,*) 'read sandfrac' + VNAME = 'SANDF' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%SANDF ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'DRAG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%DRAG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'UTHR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, + & JDATE, JTIME, Met_Data%UTHR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If +C Soil vars + VNAME = 'SOIM1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then + VNAME = 'SOIM2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIM2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SOIT2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'SOIT1' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SOIT1 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SEAICE' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SEAICE ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + +C met vars + + VNAME = 'PRSFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PRSFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RGRND' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RGRND ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'SNOCOV' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%SNOCOV ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Where( Met_Data%SNOCOV .Lt. 0.0 ) + Met_Data%SNOCOV = 0.0 + End Where + + VNAME = 'TEMP2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMP2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'TEMPG' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TEMPG ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'USTAR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%USTAR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'WSPD10' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WSPD10 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'HFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%HFX ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( iflh ) Then + VNAME = 'LH' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else ! for backward compatibility + VNAME = 'QFX' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%LH ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + VNAME = 'PBL' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%PBL ) ) THEN + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Met_cro_2D variables that have recently changed due to MCIP or WRF/CMAQ + + If ( .Not. INTERPX( MET_CRO_2D, vname_rn, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RN ) ) Then + XMSG = MSG1 // TRIM( vname_rn ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( .Not. INTERPX( MET_CRO_2D, vname_rc, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RC ) ) Then + XMSG = MSG1 // TRIM( vname_rc ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + If ( ifwr ) Then + VNAME = 'WR' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%WR ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + End If + + If ( ifsst ) Then + VNAME = 'TSEASFC' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%TSEASFC ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%TSEASFC = Met_Data%TEMPG + End If + + If ( rinv ) Then + VNAME = 'RADYNI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RA .Gt. cond_min ) + Met_Data%RA = 1.0/Met_Data%RA + Elsewhere + Met_Data%RA = resist_max + End Where + + VNAME = 'RSTOMI' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + Where( Met_Data%RS .Gt. cond_min ) + Met_Data%RS = 1.0 / Met_Data%RS + Elsewhere + Met_Data%RS = resist_max + End Where + + Else + + VNAME = 'RA' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RA ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + VNAME = 'RS' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%RS ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + + End If + + If ( ifq2 ) Then ! Q2 in METCRO2D + VNAME = 'Q2' + If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & JDATE, JTIME, Met_Data%Q2 ) ) Then + XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + End If + Else + Met_Data%Q2 = Met_Data%QV( :,:,1 ) + End If + + Es_Grnd => BUFF2D + Where( Met_Data%TEMPG .Lt. stdtemp ) + Es_Grnd = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMPG ) ) + Elsewhere + Es_Grnd = vp0 *Exp( svp2 * ( Met_Data%TEMPG -stdtemp ) / ( Met_Data%TEMPG -svp3 ) ) + End Where + Met_Data%QSS_GRND = Es_Grnd * 0.622 / ( Met_Data%PRSFC - Es_Grnd ) + Nullify( Es_Grnd ) + + Es_Air => BUFF2D + Where( Met_Data%TEMP2 .Lt. stdtemp ) + Es_Air = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMP2 ) ) + Elsewhere + Es_Air = vp0 *Exp( svp2 * ( Met_Data%TEMP2 -stdtemp ) / ( Met_Data%TEMP2 -svp3 ) ) + End Where + Met_Data%RH = Met_Data%Q2 / ( Es_Air * 0.622 / ( Met_Data%PRSFC - Es_Air ) ) * 100.0 + Where( Met_Data%RH .Gt. 100.0 ) + Met_Data%RH = 100.0 + Elsewhere( Met_Data%RH .lt. 0.0 ) + Met_Data%RH = 0.0 + End Where + Nullify( Es_Air ) + +C-------------------------------- MET_DOT_3D -------------------------------- + If ( .Not. INTERPX( MET_DOT_3D, vname_uc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%UWIND ) ) Then + XMSG = MSG1 // TRIM( vname_uc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + + If ( .Not. INTERPX( MET_DOT_3D, vname_vc, PNAME, + & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, + & JDATE, JTIME, Met_Data%VWIND ) ) Then + XMSG = MSG1 // TRIM( vname_vc ) // ' from ' // MET_DOT_3D + Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) + End If + +C get ghost values for wind fields in case of free trop. + CALL SUBST_COMM ( Met_Data%UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) + CALL SUBST_COMM ( Met_Data%VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) + +C-------------------------------- Calculated Variables -------------------------------- + Met_Data%DZF = Met_Data%ZF - EOSHIFT(Met_Data%ZF, Shift = -1, Boundary = 0.0, Dim = 3) + + Met_Data%RDEPVHT = 1.0 / Met_Data%ZF( :,:,1 ) + + IF ( MINKZ ) THEN + Met_Data%KZMIN = KZL + DO L = 1, NLAYS + Where( Met_Data%ZF( :,:,L ) .LE. KZMAXL ) + Met_Data%KZMIN( :,:,L ) = KZL + ( KZU - KZL ) * 0.01 * Grid_data%PURB + End Where + End Do + ELSE + Met_Data%KZMIN = KZ0UT + END IF + + TV => BUFF3D + TV = Met_Data%TA * ( 1.0 + 0.608 * Met_Data%QV ) + Met_Data%THETAV = TV * ( P0 / Met_Data%PRES ) ** 0.286 + Nullify( TV ) + +C------ Updating MOL, then WSTAR, MOLI, HOL + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + ! CPAIR = 1004.67 * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + CPAIR = CPD * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) + TMPFX = Met_Data%HFX( C,R ) / ( CPAIR * Met_Data%DENS( C,R,1 ) ) + TMPVTCON = 1.0 + 0.608 * Met_Data%QV( C,R,1 ) ! Conversion factor for virtual temperature + TST = -TMPFX / Met_Data%USTAR( C,R ) + IF ( Met_Data%TA( C,R,1 ) .GT. STDTEMP ) THEN + LV = LV0 - ( 0.00237 * ( Met_Data%TA( C,R,1 ) - STDTEMP ) ) * 1.0E6 + ELSE + LV = 2.83E6 ! Latent heat of sublimation at 0C from Stull (1988) (J/KG) + END IF + QST = -( Met_Data%LH( C,R ) / LV ) + & / ( Met_Data%USTAR( C,R ) * Met_Data%DENS( C,R,1 ) ) + TSTV = TST * TMPVTCON + Met_Data%THETAV( C,R,1 ) * 0.608 * QST + IF ( ABS( TSTV ) .LT. 1.0E-6 ) THEN + TSTV = SIGN( 1.0E-6, TSTV ) + END IF + Met_Data%MOL( C,R ) = Met_Data%THETAV( C,R,1 ) + & * Met_Data%USTAR( C,R ) ** 2 / ( karman * GRAV * TSTV ) + IF ( Met_Data%MOL( C,R ) .LT. 0.0 ) THEN + Met_Data%WSTAR( C,R ) = Met_Data%USTAR( C,R ) * ( Met_Data%PBL( C,R ) + & / ( karman * ABS( Met_Data%MOL( C,R ) ) ) ) ** 0.333333 + ELSE + Met_Data%WSTAR( C,R ) = 0.0 + END IF + + END DO + END DO + + Met_Data%MOLI = 1.0 / Met_Data%MOL + Met_Data%HOL = Met_Data%PBL / Met_Data%MOL +C------ + + Met_Data%CONVCT = .FALSE. + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO L = 1, NLAYS + IF ( Met_Data%PBL( C,R ) .LT. Met_Data%ZF( C,R,L ) ) THEN + LP = L; EXIT + END IF + END DO + + Met_Data%LPBL( C,R ) = LP + If ( LP .Eq. 1 ) Then + FINT = ( Met_Data%PBL( C,R ) ) + & / ( Met_Data%ZF( C,R,LP ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + Else + FINT = ( Met_Data%PBL( C,R ) - Met_Data%ZF( C,R,LP-1 ) ) + & / ( Met_Data%ZF( C,R,LP ) - Met_Data%ZF( C,R,LP-1 ) ) + Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) + & + X3FACE_GD( LP-1 ) + End If + END DO + END DO + Where( Met_Data%THETAV( :,:,1 ) - Met_Data%THETAV( :,:,2 ) .Gt. EPS .And. + & Met_Data%HOL .Lt. -0.02 .And. Met_Data%LPBL .Gt. 3 ) + Met_Data%CONVCT = .True. + End Where + + Return + End Subroutine GET_MET + + End Module ASX_DATA_MOD diff --git a/src/model/src/DUST_EMIS.F b/src/model/src/DUST_EMIS.F new file mode 100644 index 0000000..3fb64c8 --- /dev/null +++ b/src/model/src/DUST_EMIS.F @@ -0,0 +1,1525 @@ + +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + + +C RCS file, release, date & time of last delta, author, state, [and locker] +C $Header: /project/work/rep/arc/CCTM/src/emis/emis/DUST_EMIS.F,v 1.6 2011/10/21 16:10:45 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + module dust_emis + +C----------------------------------------------------------------------- +C Description: +C * Extracts selected landuse categories from BELD01 and BELD03 and merges +C * the selections into a dust-related landuse array (ULAND). + +C Optionally, reads 3 gridded crop calendar file and calculates an +C erodible agriculture land fraction. (cropcal) + +C * Applies a predetermined removal fraction in and below canopy to +C * ULAND and determines a transport factor (TFB) for this regime. +C * = applies to tfbelow + +C Function: 3d point source emissions interface to the chemistry-transport model + +C Revision History: +C 16 Dec 10 J.Young: Adapting Daniel Tong`s work on windblown dust +C 21 Apr 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 11 May 11 D.Wong: incorporated twoway model implementation +C 8 Jul 11 J.Young: unified string lengths in character lists for compiler compatibility +C 11 Nov 11 J.Young: generalizing land use/cover +C 8 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 +C 13 Jul 12 J.Young: following Daniel Tong: changed clayc, siltc, sandc units from mass +C fraction to %; adjusted F/G (vertical to horizontal flux) ratio +C to be continuous for clay content > 20% +C 30 Sep 13 J.Young: corrected diag file units description; added snow cover adjustment; +C adjusted F/G (vertical to horizontal flux) ratio to be continuous +C for clay content > 0.2; convert volumetric soil moisture to +C gravimetric water content; corrected soil moisture factor (fmoit); +C use lwmask>0 rather than sltyp>0 (non-existent) for over water test +C 15 Sep 15 H.Foroutan: revised threshold friction velocity parameterization +C 20 Oct 15 H.Foroutan: Updated the calculation of the threshold velocity(U*t), which is +C now based on dust particle size, following Shao and Lu [JGR,2000]. +C Implemented a dynamic vegetation fraction based on the MODIS FPAR. +C Introduced a new parametrization for surface roughness (z0) +C applicable to dust emission schemes, and accordingly calculated +C the friction velocity (U*) at the surface using 10m wind speed +C and the new (microspcopic) surface roughness. +C Surface roughness adjusted for estimated annual vegetation height. +C Included drag partitioning coefficient. Updated the calculation of +C the vertical-to-horizontal flux based on Lu and Shao [JGR,1999]. +C Updated the dust diag output file accordingly. +C 8 Jan 16 J.Young: Changes for computational efficiency +C 2 Feb 16 J.Young: move dust aero speciation table to AERO_DATA +C----------------------------------------------------------------------- + use lus_defn + use aero_data + + implicit none + +C windblown dust emissions rates + real, allocatable, save :: dustoutm( :,:,:,: ) ! mass emission rates [g/m**3/s] + real, allocatable, save :: dustoutn( :,:,: ) ! number emission rates [1/m**3/s] + real, allocatable, save :: dustouts( :,:,: ) ! surface-area emisrates [m2/m**3/s] + + public ndust_spc, dustoutm, dustoutn, dustouts, dust_spc, + & dust_emis_init, get_dust_emis + private + + real, allocatable, save :: dust_em( :,: ) ! total dust emissions [g/m**3/s] + +C updated values of mass fraction for "freshly emitted dust" +C based on Kok [PNAS, 2011] and Nabat et al. [ACP, 2012] + real, parameter :: fracmj = 0.07 ! mass fraction assigned to accum mode + real, parameter :: fracmk = 0.93 ! mass fraction assigned to coarse mode + +C diam`s from fracmj,fracmk-weighted 2 2-bin averages of geom means +C 2 J-mode bins: 0.1-1.0, 1.0-2.5 um +C 2 K-mode bins: 2.5-5.0, 5.0-10.0 um + real, parameter :: dgvj = 1.3914 ! geom mean diam of accum mode [um] + real, parameter :: dgvk = 5.2590 ! geom mean diam of coarse mode [um] + real, parameter :: sigj = 2.0000 ! geom std deviation of accum mode flux + real, parameter :: sigk = 2.0000 ! geom std deviation of coarse mode flux + +C Local Variables: + +C Factors for converting 3rd moment emission rates into number and 2nd moment +C emission rates. (Diameters in [um] changed to [m] ) See Equations 7b and 7c +C of Binkowski & Roselle (2003) + real :: l2sgj ! [ln( sigj )] ** 2 + real :: l2sgk ! [ln( sigk )] ** 2 + real, save :: factnumj ! = exp( 4.5 * l2sgj ) / dgvj ** 3 * 1.0e18 + real, save :: factnumk ! = exp( 4.5 * l2sgk ) / dgvk ** 3 * 1.0e18 + real, save :: factm2j ! = exp( 0.5 * l2sgj ) / dgvj * 1.0e6 + real, save :: factm2k ! = exp( 0.5 * l2sgk ) / dgvk * 1.0e6 + real, save :: factsrfj ! = pi * factm2j + real, save :: factsrfk ! = pi * factm2k + + real, save :: dustmode_dens( n_mode ) ! average modal density [kg/m**3] + real :: sumsplit, sumfrac + integer :: n, idx + +C Number of soil types: For both WRF and MM5-PX met models, there are 16 types; +C the first 12 soil types are used and the rest lumped into Other. + integer, parameter :: nsltyp = 13 + +C Variables for the windblown dust diagnostic file: + logical, save :: dustem_diag ! flag for dustemis diagnostic file + integer, parameter :: fndust_diag = 19 ! number of fixed diagnostic output vars + integer, save :: ndust_diag ! number of diagnostic output vars + real, allocatable, save :: diagv( : ) ! diagnostic output variables + real, allocatable, save :: dustbf( :,:,: ) ! diagnostic accumulate buffer + +#ifdef verbose_wbdust + real, allocatable, save :: sdiagv( : ) ! global sum of each diag output var +#endif + + type diag_type + character( 16 ) :: var + character( 16 ) :: units + character( 80 ) :: desc + end type diag_type + + type( diag_type ), allocatable, save :: diagnm( : ) + type( diag_type ), allocatable, save :: vdiagnm_emis( : ) + type( diag_type ), allocatable, save :: vdiagnm_frac( : ) + type( diag_type ), allocatable, save :: vdiagnm_ustar( : ) + type( diag_type ), allocatable, save :: vdiagnm_kvh( : ) + type( diag_type ), allocatable, save :: vdiagnm_rough( : ) + + character( 10 ) :: truncnm + character( 16 ) :: vnm + + type( diag_type ), parameter :: fdiagnm( fndust_diag ) = (/ +C var units desc +C ---------------- -------- ------------------------------------------- + & diag_type( 'Cropland_Emis ', 'g/m**3/s', 'emissions for cropland landuse type '), + & diag_type( 'Desertland_Emis ', 'g/m**3/s', 'total emis for desert types and cropland '), + & diag_type( 'Cropland_Frac ', 'percent ', 'cropland erodible landuse fraction (%) '), + & diag_type( 'Desertland_Frac ', 'percent ', 'total desert fraction (%) '), + & diag_type( 'Cropland_Ustar ', 'm/s ', 'u* for cropland '), + & diag_type( 'Cropland_kvh ', '1/m ', 'cropland vert to horiz flux ratio '), + & diag_type( 'Cropland_Rough ', ' ', 'cropland surface roughness factor '), + & diag_type( 'Soil_Moist_Fac ', ' ', 'soil moisture factor for threshold u* '), + & diag_type( 'Soil_Erode_Pot ', ' ', 'soil -> dust erodiblity potential '), + & diag_type( 'Mx_Adsrb_H2O_Frc', ' ', 'max adsorbed water fraction '), + & diag_type( 'Vegetation_Frac ', ' ', 'vegetation land coverage '), + & diag_type( 'Urban_Cover ', 'percent ', 'urban land coverage '), + & diag_type( 'Forest_Cover ', 'percent ', 'forest land coverage '), + & diag_type( 'Trfac_Above_Can ', ' ', 'transport factor above canopy '), + & diag_type( 'Trfac_Inside_Can', ' ', 'transport factor in and below canopy '), + & diag_type( 'ANUMJ ', '#/s ', 'accumulation mode number '), + & diag_type( 'ANUMK ', '#/s ', 'coarse mode number '), + & diag_type( 'ASRFJ ', 'm**2/s ', 'accumulation mode surface area '), + & diag_type( 'ASRFK ', 'm**2/s ', 'coarse mode surface area ')/) + +C Module shared variables: + real, allocatable, save :: agland( :,: ) ! agriculture land fraction + real, allocatable, save :: wmax ( :,: ) ! max adsorb water percent + real, allocatable, save :: kvh ( :,:,: ) ! ratio of vertical flux / horizontal (k factor) + real, allocatable, save :: sd_ep ( :,: ) ! soil->dust erodiblity potential + real, allocatable, save :: tfb ( :,: ) ! transport fraction in and below canopy + real, allocatable, save :: fpar ( :,: ) ! modis fpar + + integer, save :: sdate, stime ! scenario start date & time + + real :: eropot( 3 ) = ! erodible potential of soil components + & (/ 0.08, ! clay + & 1.00, ! silt + & 0.12 /) ! sand + + integer, save :: logdev + + CONTAINS + +C======================================================================= + function dust_emis_init( jdate, jtime, tstep ) result( success ) + +C Revision History. +C Aug 12, 15 D. Wong: Replaced MYPE with IO_PE_INCLUSIVE for parallel I/O +C implementation + + use hgrd_defn ! horizontal domain specifications + use aero_data ! aerosol species definitions + use asx_data_mod ! meteorology data + use utilio_defn + +C Arguments: + integer, intent( in ) :: jdate ! current model date, coded YYYYDDD + integer, intent( in ) :: jtime ! current model time, coded HHMMSS + integer, intent( in ) :: tstep ! output time step + logical success + +C Includes: + include SUBST_FILES_ID ! file name parameters + +C External Functions: + integer, external :: setup_logdev + +C Local variables: + character( 16 ) :: ctm_dustem_diag = 'CTM_DUSTEM_DIAG' ! env var for + ! diagnostic file + character( 16 ) :: ctm_erode_agland = 'CTM_ERODE_AGLAND' ! env var to + ! use erodible cropland + character( 16 ) :: pname = 'DUST_EMIS_INIT' + character( 16 ) :: vname + character( 80 ) :: vardesc + character( 120 ) :: xmsg = ' ' + character( 16 ) :: modis_fpar_1 = 'MODIS_FPAR' + ! Fraction of Absorbed Photosynthetically Active Radiation + + logical :: erode_agland = .true. ! default + integer status + integer c, r, i, j, k, l, n + integer idiag + integer n_mass_emissions + + integer gxoff, gyoff ! global origin offset from file + integer, save :: strtcol, endcol, strtrow, endrow + integer jdatemod + + type( diag_type ), allocatable :: diagnm_swap( : ) + + interface + subroutine cropcal ( jdate, jtime, agland ) + integer, intent( in ) :: jdate, jtime + real, intent( out ) :: agland( :,: ) + end subroutine cropcal + subroutine tfbelow ( jdate, jtime, tfb ) + integer, intent( in ) :: jdate, jtime + real, intent( out ) :: tfb( :,: ) + end subroutine tfbelow + end interface + +C----------------------------------------------------------------------- + + logdev = setup_logdev() + success = .true. + + + allocate ( dustoutm( ndust_spc,n_mode,ncols,nrows ), + & dustoutn( n_mode,ncols,nrows ), + & dustouts( n_mode,ncols,nrows ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating DUSTOUTM, DUSTOUTN, or DUSTOUTS' + call m3warn ( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + +C Allocate emissions array + allocate( dust_em( ncols,nrows ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating DUST_EM' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + +C Allocate private arrays + allocate( agland( ncols,nrows ), + & wmax ( ncols,nrows ), + & sd_ep ( ncols,nrows ), + & fpar ( ncols,nrows ), + & tfb ( ncols,nrows ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating AGLAND, WMAX, FPAR, SD_EP, or TFB' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + agland = 0.0 ! array assignment + wmax = 0.0 ! array assignment + sd_ep = 0.0 ! array assignment + fpar = 0.0 ! array assignment + +C Open MODIS file to get vegetation fraction + if ( .not. open3( modis_fpar_1, fsread3, pname ) ) then + xmsg = 'Could not open ' // modis_fpar_1 + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + +C Get the file description + if ( .not. desc3( modis_fpar_1 ) ) then + xmsg = 'Could not get ' + & // trim( modis_fpar_1 ) + & // ' file description' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + +C To be able to use either climatological (2001-2010 averaged) or +C current fpar value. The year for the climatological fpar is 2005 in +C the input file. + if ( sdate3d .eq. 2005001 ) then ! climatological + jdatemod = 2005000 + mod( jdate,1000 ) + else ! current + jdatemod = jdate + end if + +C Get domain decomp info + call subhfile ( modis_fpar_1, gxoff, gyoff, + & strtcol, endcol, strtrow, endrow ) + +C Read in FPAR from MODIS file + xmsg = 'Could not read FPAR from ' // trim( modis_fpar_1 ) + if ( .not. xtract3( modis_fpar_1, 'MODIS_FPAR_T', 1,1, + & strtrow,endrow,strtcol,endcol, + & jdatemod, jtime, fpar( 1,1 ) ) ) + & call m3exit ( pname, jdate, jtime, xmsg, xstat1 ) + +C Initialize land use/cover variables + if ( .not. lus_init( jdate, jtime ) ) then + xmsg = 'Failure initializing land use module' + call m3exit( pname, jdate, jtime, xmsg, xstat2 ) + end if + +C Get env var for diagnostic output + dustem_diag = .false. ! default + vardesc = 'Flag for writing the windblown dust emission diagnostic file' + dustem_diag = envyn( ctm_dustem_diag, vardesc, dustem_diag, status ) + if ( status .ne. 0 ) write( logdev,'( 5x, a )' ) vardesc + if ( status .eq. 1 ) then + xmsg = 'Environment variable improperly formatted' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + else if ( status .eq. -1 ) then + xmsg = 'Environment variable set, but empty ... Using default:' + write( logdev,'( 5x, a, i9 )' ) xmsg, jtime + else if ( status .eq. -2 ) then + xmsg = 'Environment variable not set ... Using default:' + write( logdev,'( 5x, a, i9 )' ) xmsg, jtime + end if + + if ( dustem_diag ) then ! Open the emissions diagnostic file + +C Set up variable diagnostic names (from LUS_DEFN) + allocate( vdiagnm_emis ( n_dlcat ), + & vdiagnm_frac ( n_dlcat ), + & vdiagnm_kvh ( n_dlcat ), + & vdiagnm_rough( n_dlcat ), + & vdiagnm_ustar( n_dlcat ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating VDIAGNM_*' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + vdiagnm_emis = diag_type( ' ', ' ', ' ' ) ! array assignment + vdiagnm_frac = diag_type( ' ', ' ', ' ' ) ! array assignment + vdiagnm_ustar = diag_type( ' ', ' ', ' ' ) ! array assignment + vdiagnm_kvh = diag_type( ' ', ' ', ' ' ) ! array assignment + vdiagnm_rough = diag_type( ' ', ' ', ' ' ) ! array assignment + +C...Count the number of mass emissions species + n_mass_emissions = 0 + do i = 1, ndust_spc + do j = 1, n_mode + if( len_trim( dust_spc( i )%name( j ) ) .lt. 1 )cycle + n_mass_emissions = n_mass_emissions + 1 + end do + end do + + ndust_diag = fndust_diag + 5 * n_dlcat + n_mass_emissions + + do i = 1, n_dlcat + truncnm = vnmld( i )%desc ! char( 10 ) +C... replace embedded spaces (within 16 chars) with "_" +C... replace embedded dashes (within 16 chars) with "_" + l = len_trim( truncnm ) + do k = 1, l + if ( truncnm( k:k ) .eq. " " .or. + & truncnm( k:k ) .eq. "-" ) truncnm( k:k ) = "_" + end do + vnm = trim( truncnm ) // '_Emis' ! char( 16 ) + vdiagnm_emis( i ) = diag_type( vnm, 'g/m**2/s', vnmld( i )%desc ) + vnm = trim( truncnm ) // '_Frac' ! char( 16 ) + vdiagnm_frac( i ) = diag_type( vnm, 'percent', vnmld( i )%desc ) + vnm = trim( truncnm ) // '_Ustr' ! char( 16 ) + vdiagnm_ustar( i ) = diag_type( vnm, 'm/s', vnmld( i )%desc ) + vnm = trim( truncnm ) // '_Kvh' ! char( 16 ) + vdiagnm_kvh( i ) = diag_type( vnm, '1/m', vnmld( i )%desc ) + vnm = trim( truncnm ) // '_Rough' ! char( 16 ) + vdiagnm_rough( i ) = diag_type( vnm, ' ', vnmld( i )%desc ) + end do + +C Allocate diagnostic emissions arrays + allocate( diagnm( ndust_diag ), ! diag_type + & diagv ( ndust_diag ), + & dustbf( ndust_diag,ncols,nrows ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating DIAGNM, DIAGV or DUSTBF' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + +#ifdef verbose_wbdust + allocate( sdiagv( ndust_diag ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating SDIAGV' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if +#endif + +C Build the complete diagnostic name array n for MODIS NOAH + do i = 1, n_dlcat ! 4 + diagnm( i ) = vdiagnm_emis( i ) + end do + n = n_dlcat + 1 + diagnm( n ) = fdiagnm( 1 ) ! Cropland_Emis + n = n + 1 + diagnm( n ) = fdiagnm( 2 ) ! Desertland_Emis + + do i = 1, n_dlcat + diagnm( i+n ) = vdiagnm_frac( i ) + end do + n = n + n_dlcat + 1 + diagnm( n ) = fdiagnm( 3 ) ! Cropland_Frac + n = n + 1 + diagnm( n ) = fdiagnm( 4 ) ! Desertland_Frac + + do i = 1, n_dlcat + diagnm( i+n ) = vdiagnm_ustar( i ) + end do + n = n + n_dlcat + 1 + diagnm( n ) = fdiagnm( 5 ) ! Cropland_Ustar + + do i = 1, n_dlcat + diagnm( i+n ) = vdiagnm_kvh( i ) + end do + n = n + n_dlcat + 1 + diagnm( n ) = fdiagnm( 6 ) ! Cropland_Kvh + + do i = 1, n_dlcat + diagnm( i+n ) = vdiagnm_rough( i ) + end do + n = n + n_dlcat + 1 + diagnm( n ) = fdiagnm( 7 ) ! Cropland_Rough + + n = n - 7 ! add remaining variables in fdiagnm + do i = 8, fndust_diag + idiag = i+n + diagnm( idiag ) = fdiagnm( i ) + end do + +C...append diagnostic variables with mass emissions species + do j = 2, n_mode + do i = 1, ndust_spc + n = len_trim( dust_spc( i )%name( j ) ) + if( n .lt. 1 )cycle ! assumes cmaq species names atleast one character long + n = 0 + do k = 1, idiag ! determine if dust emissions is already added to diagnostic output + if( dust_spc( i )%name( j ) .Eq. diagnm( k )%var )Then + n = k + exit + end if + end do + if( n .gt. 0 )then ! skip already added + cycle + else + idiag = idiag + 1 + diagnm( idiag )%var = dust_spc( i )%name( j ) + end if + diagnm( idiag )%units = 'g/m**3/s' + Select Case( j ) ! assumes only two aerosol modes dust emissions +! Case( 1 ) +! diagnm( idiag )%desc = 'aitken mode' + Case( 2 ) + diagnm( idiag )%desc = 'accumulation mode' + Case( 3 ) + diagnm( idiag )%desc = 'coarse mode' +! Case Default +! diagnm( idiag )%des = 'Undefined mode ' + end Select + diagnm( idiag )%desc = Trim( diagnm( idiag )%desc ) + & // ' emissions for ' + & // Trim( dust_spc( i )%description ) + end do + end do + +! remove unused space in diagnm by deallocated and reallocating to idiag value + allocate( diagnm_swap( ndust_diag ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating DIAGNM_SWAP' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + diagnm_swap = diagnm + + deallocate( diagnm ) + + ndust_diag = idiag + allocate( diagnm( ndust_diag ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure reallocating DIAGNM' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + end if + diagnm( 1:ndust_diag ) = diagnm_swap( 1:ndust_diag ) + deallocate( diagnm_swap ) + + sdate = envint( 'CTM_STDATE', 'Scenario Start (YYYYJJJ)', 0, status ) + stime = envint( 'CTM_STTIME', 'Scenario Start (HHMMSS)', 0, status ) + + if ( io_pe_inclusive ) + & call opdust_emis ( sdate, stime, tstep, ndust_diag, diagnm ) + + end if ! dustem_diag + +C Get env var for erodible agriculture land fraction + erode_agland = .false. ! default + vardesc = 'Flag for calculating erodible agriculture land fraction' + erode_agland = envyn( ctm_erode_agland, vardesc, erode_agland, status ) + if ( status .ne. 0 ) write( logdev,'( 5x, a )' ) vardesc + if ( status .eq. 1 ) then + xmsg = 'Environment variable improperly formatted' + call m3warn( pname, jdate, jtime, xmsg ) + success = .false.; return + else if ( status .eq. -1 ) then + xmsg = 'Environment variable set, but empty ... Using default:' + write( logdev,'( 5x, a, i9 )' ) xmsg, jtime + else if ( status .eq. -2 ) then + xmsg = 'Environment variable not set ... Using default:' + write( logdev,'( 5x, a, i9 )' ) xmsg, jtime + end if + + if ( erode_agland ) then + call cropcal ( sdate, stime, agland ) + do r = 1, my_nrows + do c = 1, my_ncols + if ( agland( c,r ) .lt. 0.0 .or. agland( c,r ) .gt. 100.0 ) then + xmsg = '*** ERROR in AGLAND' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + end do + end do + end if + +C Get transport factor within canopy and 4 land use type percents + call tfbelow ( jdate, jtime, tfb ) + + l2sgj = log( sigj ) * log( sigj ) + l2sgk = log( sigk ) * log( sigk ) + +C Factors for converting 3rd moment emission rates into number and 2nd moment +C emission rates. (Diameters in [um] changed to [m] ) See Equations 7b and 7c +C of Binkowski & Roselle (2003) + factnumj = 1.0e18 * exp( 4.5 * l2sgj ) / dgvj ** 3 + factnumk = 1.0e18 * exp( 4.5 * l2sgk ) / dgvk ** 3 + factm2j = 1.0e06 * exp( 0.5 * l2sgj ) / dgvj + factm2k = 1.0e06 * exp( 0.5 * l2sgk ) / dgvk + factsrfj = pi * factm2j + factsrfk = pi * factm2k + +C Calculate modal average dust particle densities (accum and coarse modes) [ kg/m**3 ] +C The following works because the dust_spc`s are a fixed split of the total emitted +C mass. + dustmode_dens( 1 ) = 0.0 + do n = 2, n_mode + sumsplit = 0.0; sumfrac = 0.0 + do i = 1, ndust_spc + idx = findAero( dust_spc( i )%name( n ), .true. ) + if( aerospc( idx )%tracer )cycle + if( dust_spc( i )%spcfac( n ) .lt. 1.0e-30 )cycle + sumsplit = sumsplit + dust_spc( i )%spcfac( n ) ! should = 1.0 + sumfrac = sumfrac + dust_spc( i )%spcfac( n ) / aerospc( idx )%density + end do + dustmode_dens( n ) = sumsplit / sumfrac + end do + +#ifdef verbose_wbdust + write( logdev,* ) ' ' + write( logdev,* ) ' l2sgj,l2sgk: ', l2sgj, l2sgk + write( logdev,* ) ' factnumj,factnumk: ', factnumj, factnumk + write( logdev,* ) ' factm2j,factm2k: ', factm2j, factm2k + write( logdev,* ) ' factsrfj,factsrfk: ', factsrfj, factsrfk + write( logdev,* ) ' modal avg dens(j/k): ', dustmode_dens( 2 ), dustmode_dens( 3 ) + write( logdev,* ) ' ' +#endif + + end function dust_emis_init + +C======================================================================= + subroutine opdust_emis ( jdate, jtime, tstep, ndust_var, dust_var ) + +C 27 Dec 10 J.Young: initial + + use grid_conf ! horizontal & vertical domain specifications + use utilio_defn + + implicit none + + include SUBST_FILES_ID ! file name parameters + +C Arguments: + integer, intent( in ) :: jdate ! current model date, coded YYYYDDD + integer, intent( in ) :: jtime ! current model time, coded HHMMSS + integer, intent( in ) :: tstep ! output time step + integer, intent( in ) :: ndust_var + type( diag_type ), intent( in ) :: dust_var( : ) + +C Local variables: + character( 16 ) :: pname = 'OPDUST_EMIS' + character( 96 ) :: xmsg = ' ' + + integer v, l ! loop induction variables + +C----------------------------------------------------------------------- + +C Try to open existing file for update + if ( .not. open3( ctm_dust_emis_1, fsrdwr3, pname ) ) then + xmsg = 'Could not open CTM_DUST_EMIS_1 for update - ' + & // 'try to open new' + call m3mesg( xmsg ) + +C Set output file characteristics based on COORD.EXT and open diagnostic file + ftype3d = grdded3 + sdate3d = jdate + stime3d = jtime + tstep3d = tstep + call nextime( sdate3d, stime3d, tstep3d ) ! start the next hour + + nvars3d = ndust_var + ncols3d = gl_ncols + nrows3d = gl_nrows + nlays3d = 1 + nthik3d = 1 + gdtyp3d = gdtyp_gd + p_alp3d = p_alp_gd + p_bet3d = p_bet_gd + p_gam3d = p_gam_gd + xorig3d = xorig_gd + yorig3d = yorig_gd + xcent3d = xcent_gd + ycent3d = ycent_gd + xcell3d = xcell_gd + ycell3d = ycell_gd + vgtyp3d = vgtyp_gd + vgtop3d = vgtop_gd +! vgtpun3d = vgtpun_gd ! currently, not defined + do l = 1, nlays3d + 1 + vglvs3d( l ) = vglvs_gd( l ) + end do + gdnam3d = grid_name ! from HGRD_DEFN + + do v = 1, nvars3d + vtype3d( v ) = m3real + vname3d( v ) = dust_var( v )%var + units3d( v ) = dust_var( v )%units + vdesc3d( v ) = dust_var( v )%desc + end do + + fdesc3d( 1 ) = 'windblown dust parameters, variables, and' + fdesc3d( 2 ) = 'hourly layer-1 windblown dust emission rates' + do l = 3, mxdesc3 + fdesc3d( l ) = ' ' + end do + +C Open windblown dust emissions diagnostic file + if ( .not. open3( ctm_dust_emis_1, fsnew3, pname ) ) then + xmsg = 'Could not create the CTM_DUST_EMIS_1 file' + call m3exit( pname, sdate3d, stime3d, xmsg, xstat1 ) + end if + + end if + + return + + end subroutine opdust_emis + +C======================================================================= + subroutine get_dust_emis( jdate, jtime, tstep, rjacm, cellhgt ) + + use grid_conf ! horizontal & vertical domain specifications + use asx_data_mod ! meteorology data + use aero_data + use utilio_defn + +C 8/18/11 D.Wong: incorporated twoway model implementation and change +C RC -> RCA and RN -> RNA and made it backward compatible +C 8/12/15 D.Wong: added code to handle parallel I/O implementation + +C Arguments: + integer, intent( in ) :: jdate ! current model date, coded YYYYDDD + integer, intent( in ) :: jtime ! current model time, coded HHMMSS + integer, intent( in ) :: tstep( 3 ) ! output time step, sync step, 2way step + real, intent( in ) :: rjacm( ncols,nrows ) ! reciprocal Jacobian [1/m] + real, intent( in ) :: cellhgt ! grid-cell height [sigma] + +C Includes: + include SUBST_FILES_ID ! file name parameters + +C External Functions: + +C Parameters: + integer, parameter :: ndp = 4 ! number of soil texture type particle sizes: + ! 1 Coarse sand + ! 2 Fine-medium sand + ! 3 Silt + ! 4 Clay + + real, parameter :: f6dpi = 6.0 / pi + real, parameter :: gpkg = 1.0e03 ! g/kg + + real, parameter :: mv = 0.16 + real, parameter :: sigv = 1.45 + real, parameter :: betav = 202.0 + real, parameter :: sigv_mv = sigv * mv ! = 0.232 + real, parameter :: betav_mv = betav * mv ! = 32.32 + real, parameter :: mb = 0.5 + real, parameter :: sigb = 1.0 + real, parameter :: betab = 90.0 + real, parameter :: sigb_mb = sigb * mb ! = 0.5 + real, parameter :: betab_mb = betab * mb ! = 45.0 + + real, parameter :: alpha = 0.7 + + character( 16 ) :: pname = 'GET_DUST_EMIS' + character( 16 ) :: vname + character( 96 ) :: xmsg + integer status + integer c, r, j, m, n, v + + integer, save :: wstep = 0 ! local write counter + integer :: mdate, mtime ! diagnostic file write date&time + + ! automatic arrays + real :: fmoit ( ncols,nrows ) ! factor of soil moisture on u*t + real :: soimt ( ncols,nrows ) ! gravimetric soil moisture (Kg/Kg) + real :: tfa ( ncols,nrows ) ! transport fraction above canopy + real :: wrbuf ( ncols,nrows ) ! diagnositc write buffer + real :: vegfrac( ncols,nrows ) ! vegetation fraction + real :: vegfree ! 1.0 - vegfrac for this col, row + real :: lai ( ncols,nrows ) ! leaf area index + + real, allocatable, save :: ustr ( :,:,: ) ! U* [m/s] + real, allocatable, save :: qam ( :,:,: ) ! emis for landuse type [g/m**2/s] + real, allocatable, save :: elus ( :,:,: ) ! erodible landuse percent (0~100) + real, allocatable, save :: fruf ( :,:,: ) ! surface roughness factor + + real :: edust( n_mode ) ! mass emis rate [g/s] per mode (only accum & coarse) + real :: sumdfr ! sum var for desert fraction + real :: rlay1hgt ! reciprocal of layer-1 height [1/m] + real :: m3j ! 3rd moment accumulation (J) mode emis rates [m3/m3/s] + real :: m3k ! 3rd moment coarse mode (K) emis rates [m3/m3/s] + real :: fruf2 ! surface roughness factor squared + + character( 16 ), save :: rc_name, rn_name ! new names: RC -> RCA, RN -> RNA + logical, save :: firstime = .true. + + real :: lambda, vegheight + real :: z0 + real :: lambdav ! vegetation roughness density - Shao et. al [Aus. J. Soil Res., 1996] + real :: flxfac1, flxfac2 ! combined soli type mapping factors + real :: hflux, vflux ! horizontal and vertical dust flux + real :: jday + integer :: emap( n_dlcat+1 ) + +C---FENGSHA FLAG + +C CHARACTER( 20 ), SAVE :: CTM_FENGHSA = 'CTM_FENGSHA ' ! env var for in-line +C LOGICAL, SAVE :: FENGSHA ! flag in-lining canopy shading + +C---Height for veg elements + real :: hv( 4 ) + +C---Roughness density for solid elements +C from Darmenova et al. [JGR,2009] and Xi and Sokolik [JGR,2015] + real :: lambdab( 4 ) = + & (/ 0.03, ! shrubland + & 0.04, ! shrubgrass + & 0.0001, ! barrenland + & 0.15 /) ! cropland + +C---Compound for computational efficiency + real :: hb_lambdab( 4 ) = + & (/ 6.0e-04, ! shrubland + & 8.0e-04, ! shrubgrass + & 2.0e-06, ! barrenland + & 3.0e-03 /) ! cropland + +C Soil moisture limit: 13 types and 3 variables, which are: +C 1 - saturation moisture limit, (gravimetric units assumed, Kg/Kg) +C 2 - fill capacity, and <- not used +C 3 - wilting point <- not used +C Modified values compatiable with both MM5 & NAM. +C Silt values are based on NAM documentation on soil types. +C Other includes all types higher than 12. The values of Other, serving as +C placeholders, are randomly chosen. Values of Other, however, have no effect +C on dust emissions as the threshold velocity of Other will be high. +C real :: soilml( nsltyp,3 ) = reshape ( +C & (/ 0.395, 0.135, 0.068, ! Sand +C & 0.410, 0.150, 0.075, ! Loamy Sand +C & 0.435, 0.195, 0.114, ! Sandy Loam +C & 0.485, 0.255, 0.179, ! Silt Loam +C & 0.476, 0.361, 0.084, ! Silt +C & 0.451, 0.240, 0.155, ! Loam +C & 0.420, 0.255, 0.175, ! Sandy Clay Loam +C & 0.477, 0.322, 0.218, ! Silty Clay Loam +C & 0.476, 0.325, 0.250, ! Clay Loam +C & 0.426, 0.310, 0.219, ! Sandy Clay +C & 0.482, 0.370, 0.283, ! Silty Clay +C & 0.482, 0.367, 0.286, ! Clay +C & 0.482, 0.367, 0.286 /), ! Other +C & (/ nsltyp,3 /), order = (/ 2,1 /) ) ! fill columns first + +C converted to gravimetric [kg/kg] + real :: soilml1( nsltyp ) = + & (/ 0.242, ! Sand + & 0.257, ! Loamy Sand + & 0.286, ! Sandy Loam + & 0.350, ! Silt Loam + & 0.350, ! Silt + & 0.307, ! Loam + & 0.277, ! Sandy Clay Loam + & 0.350, ! Silty Clay Loam + & 0.332, ! Clay Loam + & 0.284, ! Sandy Clay + & 0.357, ! Silty Clay + & 0.344, ! Clay + & 0.363 /) ! Other + +C---Soil texture: the amount of +C 1: Coarse sand, 2: Fine-medium sand, 3: Silt, 4: Clay +C in each soil type [Kg/Kg]. from Menut et al. [JGR,2013] + real :: soiltxt( nsltyp,ndp ) = reshape ( + & (/ 0.46, 0.46, 0.05, 0.03, ! Sand + & 0.41, 0.41, 0.18, 0.00, ! Loamy Sand + & 0.29, 0.29, 0.32, 0.10, ! Sandy Loam + & 0.00, 0.17, 0.70, 0.13, ! Silt Loam + & 0.00, 0.10, 0.85, 0.05, ! Silt + & 0.00, 0.43, 0.39, 0.18, ! Loam + & 0.29, 0.29, 0.15, 0.27, ! Sandy Clay Loam + & 0.00, 0.10, 0.56, 0.34, ! Silty Clay Loam + & 0.00, 0.32, 0.34, 0.34, ! Clay Loam + & 0.00, 0.52, 0.06, 0.42, ! Sandy Clay + & 0.00, 0.06, 0.47, 0.47, ! Silty Clay + & 0.00, 0.22, 0.20, 0.58, ! Clay + & 0.00, 0.00, 0.00, 0.00 /), ! Other + & (/ nsltyp,4 /), order = (/ 2,1 /) ) ! fill columns first + +C---Mean mass median particle diameter (m) for each soil texture type +C Chatenet et al. [Sedimentology,1996] and Menut et al. [JGR,2013] + real :: dp( ndp ) = + & (/ 690.0E-6, ! Coarse sand + & 210.0E-6, ! Fine-medium sand + & 125.0E-6, ! Silt + & 2.0E-6 /) ! Clay + + + interface + subroutine tfabove ( tfa ) + real, intent( out ) :: tfa( :,: ) + end subroutine tfabove + end interface + +#ifdef verbose_wbdust + integer dryhit + integer dusthit +#endif + +C----------------------------------------------------------------------- + + if ( firstime ) then + +! FENGHSA = ENVYN( 'CTM_FENGSHA', +! & 'Flag for fengsha dust emission module', +! & .FALSE., IOSX ) + IF ( FENGSHA ) THEN + XMSG = 'Using Fengsha dust emission module ' + CALL M3MSG2( XMSG ) + END IF + + firstime = .false. + allocate ( ustr( ncols,nrows,n_dlcat+1 ), + & qam( ncols,nrows,n_dlcat+1 ), + & fruf( ncols,nrows,n_dlcat+1 ), + & kvh( ncols,nrows,n_dlcat+1 ), + & elus( ncols,nrows,n_dlcat+1 ), stat = status ) + if ( status .ne. 0 ) then + xmsg = '*** Failure allocating USTR, QAM, FRUF, KVH, or ELUS' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + end if + +C---Calculate transport factor above the canopy + call tfabove ( tfa ) + +C---Get Julian day number in year + jday = float( mod( jdate,1000 ) ) + +C---Vegetation height dynamically changed based on the month of the year +C Veg. heights in [m] for 1: Shrubland 2: shrubgrass 3: barrenland 4: Cropland +C following the idea of Xi and Sokolik [JGR,2015] + if ( jday .gt. 59 .and. jday .le. 90 ) then ! Mar + hv = (/ 0.15 , 0.05 , 0.10 , 0.05 /) + else if ( jday .gt. 90 .and. jday .le. 120 ) then ! Apr + hv = (/ 0.15 , 0.10 , 0.10 , 0.05 /) + else if ( jday .gt. 120 .and. jday .le. 151 ) then ! May + hv = (/ 0.12 , 0.20 , 0.10 , 0.10 /) + else if ( jday .gt. 151 .and. jday .le. 181 ) then ! Jun + hv = (/ 0.12 , 0.15 , 0.10 , 0.30 /) + else if ( jday .gt. 181 .and. jday .le. 212 ) then ! Jul + hv = (/ 0.10 , 0.12 , 0.10 , 0.50 /) + else if ( jday .gt. 212 .and. jday .le. 243 ) then ! Aug + hv = (/ 0.10 , 0.12 , 0.10 , 0.50 /) + else if ( jday .gt. 243 .and. jday .le. 273 ) then ! Sep + hv = (/ 0.10 , 0.10 , 0.10 , 0.30 /) + else if ( jday .gt. 273 .and. jday .le. 304 ) then ! Oct + hv = (/ 0.05 , 0.08 , 0.10 , 0.10 /) + else ! Nov-Feb + hv = (/ 0.05 , 0.05 , 0.05 , 0.05 /) + end if + +#ifdef verbose_wbdust + dryhit = 0 + dusthit = 0 +#endif + +C Initialize windblown dust diagnostics output buffer + if ( dustem_diag .and. wstep .eq. 0 ) then + dustbf = 0.0 ! array assignment +#ifdef verbose_wbdust + sdiagv = 0.0 ! array assignment +#endif + end if + +C set erodible landuse map + do m = 1, n_dlcat + emap( m ) = dmap( m ) ! dmap maps to one of the 3 BELD3 desert types + end do + emap( n_dlcat+1 ) = 4 + +C --------- ###### Start Main Loop ###### --------- + + do r = 1, my_nrows + do c = 1, my_ncols + dust_em( c,r ) = 0.0 + soimt( c,r ) = 0.0 + fmoit( c,r ) = 0.0 ! for diagnostic output visualization + vegfrac( c,r ) = 0.0 + do m = 1, n_dlcat+1 + ustr( c,r,m ) = 0.0 ! for diagnostic output visualization + qam ( c,r,m ) = 0.0 + elus( c,r,m ) = 0.0 + fruf( c,r,m ) = 0.0 + kvh ( c,r,m ) = 0.0 + end do + + rlay1hgt = rjacm ( c,r ) / cellhgt + +C---Vegetation fraction based on the MODIS FPAR + vegfrac( c,r ) = max( min( fpar( c,r ), 0.95 ), 0.005 ) + vegfree = 1.0 - vegfrac( c,r ) + lambdav = -0.35 * log( vegfree ) ! Shao et al. [Aus. J. Soil Res.,1996] + +C---Dust possiblity only if 1. not over water +C 2. rain < 1/100 in. (1 in. = 2.540 cm) +C 3. not snow-covered +C 4. if soimt <= limit +C 5. desert type or ag landuse +C 6. erodible landuse +C 7. friction velocity > threshold + +!----------------------------------------------------------- +!---------------------- FENGSHA Option --------------------- +!----------------------------------------------------------- + + if ( ( FENGSHA.eq. .true.) .and. ( Grid_Data%lwmask( c,r ) .gt. 0.0 ) .and. + & ( Met_Data%rn( c,r ) + Met_Data%rc( c,r ) .le. 0.0254 ) .and. ! rn, rc = [cm] + & ( Met_Data%snocov( c,r ) .lt. 0.001 ) .and. + & ( Met_Data%drag(c,r) .gt. 0.0 ) ) then ! less than 0.1% snow coverage + +C Calculate maximum amount of the water absorbed +C w` = 0.0014(%clay)**2 + 0.17(%clay) - w` in % +C Fecan et al. [1999,Annales Geophys.,17,144-157] + wmax ( c,r ) = (100.*Met_Data%clayf( c,r )) * + & (100.*Met_Data%clayf( c,r )) * + & .0014d0 + 0.17d0 * (100.*Met_Data%clayf( c,r )) + + soimt( c,r ) = dust_volumetric_to_gravimetric( Met_Data%soim1( c,r ), Met_Data%clayf( c,r ), Met_Data%sandf( c,r )) + +C---Soil moisture effect on U*t + if ( soimt( c,r ) .le. 0.01 * wmax( c,r ) ) then ! wmax in [%] + fmoit( c,r ) = 1.0 + else + fmoit( c,r ) = sqrt( 1.0 + 1.2 * ( 100.0 * soimt( c,r ) - wmax( c,r ) ) ** 0.68 ) + end if + +C Calculate Vertical to Horizontal Mass Flux Ratio +C -- This is based on MB95 + if ( Met_Data%clayf(c,r) < 0.2) then + kvh( c,r,1 ) = 10. ** (0.134 * (Met_Data%clayf( c,r )*100.) - 6.0) + else + kvh(c,r,1) = 4.0e-4 + endif +C Horizontal Flux + hflux = dust_hflux_fengsha( Met_Data%USTAR( c,r ), + & fmoit( c,r), + & Met_Data%drag( c,r ), + & Met_Data%uthr( c,r ), + & 1.0, ! ssm = 1 + & Met_Data%dens1( c,r ) ) + vflux = hflux * kvh( c,r,1 ) ! [g/m**2/s] + + qam (c,r,1) = qam(c,r,1) + vflux * rlay1hgt * alpha + + dust_em( c,r ) = dust_em( c,r ) + qam(c,r,1) * tfa(c,r) * tfb(c,r) + + +!-------------------------------------------------------------------- +!--------------------- END OF FENGSHA ------------------------------- +!-------------------------------------------------------------------- + + else if ( ( Grid_Data%lwmask( c,r ) .gt. 0.0 ) .and. + & ( Met_Data%rn( c,r ) + Met_Data%rc( c,r ) .le. 0.0254 ) .and. ! rn, rc = [cm] + & ( Met_Data%snocov( c,r ) .lt. 0.001 ) ) then ! less than 0.1% snow coverage + +C---Dust possiblity 1,2,3 + + j = Grid_Data%sltyp( c,r ) + +C kludge (fixed in wrf-px after 4 Mar 11) + if ( j .gt. 4 ) j = j + 1 ! PX combines "silt" with "silt loam" + if ( j .gt. 13 ) j = 13 ! = ? + +C Calculate maximum amount of the adsorbed water +C w` = 0.0014(%clay)**2 + 0.17(%clay) - w` in % +C Fecan et al. [1999,Annales Geophys.,17,144-157] + wmax( c,r ) = ( 14.0 * soiltxt( j,4 ) + 17.0 ) * soiltxt( j,4 ) ! [%] + +! write( logdev,'( 2x, a, i8.6, f12.5 )' ) 'max wmax:', jtime, maxval( wmax ) + +C Change soil moisture units from volumetric (m**3/m**3) to gravimetric (Kg/Kg) + soimt( c,r ) = Met_Data%soim1( c,r ) ! <- [m**3/m**3] + & * 1000.0 / ( 2650.0 * ( 0.511 + 0.126 + & * ( soiltxt( j,1 ) + soiltxt( j,2 ) ) ) ) + + if ( soimt( c,r ) .le. soilml1( j ) ) then +C---Dust possiblity 4 + +#ifdef verbose_wbdust + dryhit = dryhit + 1 +#endif + +C---Soil moisture effect on U*t + if ( soimt( c,r ) .le. 0.01 * wmax( c,r ) ) then ! wmax in [%] + fmoit( c,r ) = 1.0 + else + fmoit( c,r ) = sqrt( 1.0 + 1.21 + & * ( 100.0 * soimt( c,r ) - wmax( c,r ) ) ** 0.68 ) + end if + +C---Erodibility potential of soil component + sd_ep( c,r ) = soiltxt( j,4 ) * eropot( 1 ) + & + soiltxt( j,3 ) * eropot( 2 ) + & + ( soiltxt( j,1 ) + soiltxt( j,2 ) ) * eropot( 3 ) + +C---Lu and Shao [JGR,1999] and Kang et al. [JGR,2011] +C First, mapping soil types into 4 main soil types following Kang et al. [JGR,2011] + select case ( j ) + case( 1, 2 ) ! sand + ! pp = 5000.0 + ! calpha = 0.001 + ! pfrac = 0.06 + ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp + flxfac1 = 5.886e-05 + ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) + flxfac2 = 1.5215430 + case( 3, 4, 6, 8, 9 ) ! loam + ! pp = 10000.0 + ! calpha = 0.0006 + ! pfrac = 0.18 + ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp + flxfac1 = 5.2974e-05 + ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) + flxfac2 = 1.0758933 + case( 7 ) ! sandy clay loam + ! pp = 10000.0 + ! calpha = 0.0006 + ! pfrac = 0.32 + ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp + flxfac1 = 9.4176e-05 + ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) + flxfac2 = 1.0758933 + case( 5, 10, 11, 12 ) ! clay + ! pp = 30000.0 + ! calpha = 0.0002 + ! pfrac = 0.72 + ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp + flxfac1 = 2.3544e-05 + ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) + flxfac2 = 0.1964303 + case default ! others -- no dust + ! pp = 100000.0 + ! calpha = 1.0 + ! pfrac = 0.0 + ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp + flxfac1 = 0.0 + ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) + flxfac2 = 0.3402273 + end select + + do m = 1, n_dlcat ! desert type landuse category + elus( c,r,m ) = ladut( c,r,m ) * vegfree ! desert land [%] + end do + elus( c,r,n_dlcat+1 ) = agland( c,r ) * vegfree ! crop land [%] + +C ------- Start Loop Over Erodible Landuse ---- + + do m = 1, n_dlcat+1 ! desert type & crop landuse categories + + if ( elus( c,r,m ) .gt. 100.0 .or. elus( c,r,m ) .lt. 0.0 ) then + write( xmsg,2009 ) elus( c,r,m ), c, r, m + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + + if ( elus( c,r,m ) .gt. 0.0 ) then + + n = emap( m ) + lambda = lambdab( n ) + lambdav + vegheight = ( hb_lambdab( n ) + hv( n ) * lambdav ) / lambda + +C---New parametrization for surface roughness by H. Foroutan - Oct. 2015 + if ( lambda .le. 0.2 ) then + z0 = 0.96 * ( lambda ** 1.07 ) * vegheight + else + z0 = 0.083 * ( lambda ** ( -0.46 ) ) * vegheight + end if + +C---Calculate friction velocity (U*) at the surafce applicable to dust emission + ustr( c,r,m ) = karman * Met_Data%WSPD10( c,r ) / log ( 10.0 / z0 ) + +C---Roughness effect on U*t (Drag partitioning) +C Xi and Sokolik [JGR,2015] + fruf2 = ( 1.0 - sigv_mv * lambdav ) + & * ( 1.0 + betav_mv * lambdav ) + & * ( 1.0 - sigb_mb * lambdab( n ) / vegfree ) + & * ( 1.0 + betab_mb * lambdab( n ) / vegfree ) + + if( fruf2 .gt. 1.0 ) then + + fruf( c,r,m ) = sqrt( fruf2 ) + else + fruf( c,r,m ) = 10.0 + end if + +C---Vert-to-Horiz dust flux ratio : Kang et al. [JGR, 2011] : Eq. (12) +! kvh( c,r,m ) = ( calpha * 9.81 * pfrac * 1000.0 / 2.0 / pp ) +! & * ( 0.24 + 2.09 * ustr( c,r,m ) * sqrt( 2650.0 / pp ) ) + kvh( c,r,m ) = flxfac1 * ( 0.24 + flxfac2 * ustr( c,r,m ) ) + hflux = dust_hflux( ndp, dp, + & soiltxt( j,: ), + & fmoit( c,r ), + & fruf( c,r,m ), + & ustr( c,r,m ), + & sd_ep( c,r ), + & Met_Data%dens1( c,r ) ) + vflux = hflux * kvh( c,r,m ) ! [g/m**2/s] + qam( c,r,m ) = qam( c,r,m ) + vflux * rlay1hgt + & * ( elus( c,r,m ) * 0.01 ) ! [g/m**3/s] + end if ! if erodible land + + if ( elus( c,r,m ) .eq. 0.0 .and. qam( c,r,m ) .ne. 0.0 ) then + xmsg = 'Erodible land use = 0, but emissions .ne. 0' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + + dust_em( c,r ) = dust_em( c,r ) + qam( c,r,m ) + + end do ! m landuse + +C ------- End Loop Over Erodible Landuse ---- + +C Dust removal by surrounding vegetation <-??? +C Adjust dust emissions for transport factors + + dust_em( c,r ) = dust_em( c,r ) * tfa( c,r ) * tfb( c,r ) + + end if ! if soil moisture + end if ! if rain & land & snow + + end do ! c + end do ! r + +C --------- ###### End Main Loop ##### --------- + +#ifdef verbose_wbdust + write( logdev,'( /5x, a, 1x, 2i8 )' ) 'dry hit count, + & out of total cells:', + & dryhit, (c-1)*(r-1) +#endif + + do r = 1, my_nrows + do c = 1, my_ncols + +C J/K mass emis rate [g/s] (edust( 1 ) not used) + edust( 2 ) = fracmj * dust_em( c,r ) + edust( 3 ) = fracmk * dust_em( c,r ) + + do v = 1, ndust_spc + dustoutm( v,1,c,r ) = 0.0 + end do + + do n = 2, n_mode + do v = 1, ndust_spc + dustoutm( v,n,c,r ) = edust( n ) * dust_spc( v )%spcfac( n ) + end do + end do + +C J/K 3rd moment emis rate [m3/s] (needed for number and surface) + m3j = edust( 2 ) * f6dpi / ( gpkg * dustmode_dens( 2 ) ) + m3k = edust( 3 ) * f6dpi / ( gpkg * dustmode_dens( 3 ) ) + +C Mode-specific emission rates of particle number [1/s] + dustoutn( 1,c,r ) = 0.0 + dustoutn( 2,c,r ) = m3j * factnumj + dustoutn( 3,c,r ) = m3k * factnumk + +C Mode-specific dry surface area emission rates [m**2/s]. +C 2nd moment multiplied by PI to obtain the surface area emissions rate. + dustouts( 1,c,r ) = 0.0 + dustouts( 2,c,r ) = m3j * factsrfj + dustouts( 3,c,r ) = m3k * factsrfk + +#ifdef verbose_wbdust + if ( m3j .ne. 0.0 ) dusthit = dusthit + 1 +#endif + + if ( dustem_diag ) then + do m = 1, n_dlcat+1 + diagv( m ) = qam( c,r,m ) ! g/m**3/s + end do + n = n_dlcat + 2 + diagv( n ) = dust_em( c,r ) ! g/m**3/s + + sumdfr = 0.0 + do m = 1, n_dlcat+1 + diagv( m+n ) = elus( c,r,m ) + sumdfr = sumdfr + elus( c,r,m ) + end do + n = n + n_dlcat + 2 + diagv( n ) = sumdfr + + do m = 1, n_dlcat+1 + diagv( m+n ) = ustr( c,r,m ) + end do + n = n + n_dlcat + 1 + + do m = 1, n_dlcat+1 + diagv( m+n ) = kvh( c,r,m ) + end do + n = n + n_dlcat + 1 + + do m = 1, n_dlcat+1 + diagv( m+n ) = fruf( c,r,m ) + end do + n = n + n_dlcat + 1 + + diagv( n+1 ) = fmoit( c,r ) ! 'Soil_Moist_Fac ' + diagv( n+2 ) = sd_ep( c,r ) ! 'Soil_Erode_Pot ' + diagv( n+3 ) = wmax ( c,r ) ! 'Mx_Adsrb_H2O_Frc' + diagv( n+4 ) = vegfrac( c,r ) ! 'Vegetation_Frac ' + diagv( n+5 ) = uland( c,r,3 ) ! 'Urban_Cover ' + diagv( n+6 ) = uland( c,r,4 ) ! 'Forest_Cover ' + diagv( n+7 ) = tfa ( c,r ) ! 'Trfac_Above_Can ' + diagv( n+8 ) = tfb ( c,r ) ! 'Trfac_Inside_Can' + + n = n + 8 + +! accum and coarse mode number density emissions + diagv( n+1 ) = dustoutn( 2,c,r ) + diagv( n+2 ) = dustoutn( 3,c,r ) +! accum and coarse mode surface area density emissions + diagv( n+3 ) = dustouts( 2,c,r ) + diagv( n+4 ) = dustouts( 3,c,r ) + + n = n + 4 + m = 0 + do v = 1, ndust_spc + if ( trim( dust_spc( v )%name( 2 ) ) .ne. ' ' ) then ! accum. mode mass emissions + m = m + 1 + diagv( m+n ) = dustoutm( v,2,c,r ) + end if + end do + + do v = 1, ndust_spc + if ( trim( dust_spc( v )%name( 3 ) ) .ne. ' ' ) then ! coarse mode mass emissions + m = m + 1 + diagv( m+n ) = dustoutm( v,3,c,r ) + end if + end do + + n = n + m + + +C Multiply by sync step because when write to output we divide by the output step +C to get a timestep average. + do v = 1, ndust_diag + dustbf( v,c,r ) = dustbf( v,c,r ) + diagv( v ) + & * float( time2sec( tstep( 2 ) ) ) +#ifdef verbose_wbdust + sdiagv( v ) = sdiagv( v ) + diagv( v ) + & * float( time2sec( tstep( 2 ) ) ) +#endif + end do + end if ! dustem_diag + end do ! col + end do ! row + +#ifdef verbose_wbdust + write( logdev,'( 5x, a, 2i8 / )' ) 'dust hit count, out of total cells:', + & dusthit, (c-1)*(r-1) +#endif + + if ( dustem_diag ) then + +C If last call this hour, write out the windblown dust emissions dignostics. +C Then reset the emissions array and local write counter. + + wstep = wstep + time2sec( tstep( 2 ) ) + + if ( wstep .ge. time2sec( tstep( 1 ) ) ) then + if ( .not. currstep( jdate, jtime, sdate, stime, tstep( 1 ), + & mdate, mtime ) ) then + xmsg = 'Cannot get step date and time' + call m3exit( pname, jdate, jtime, xmsg, xstat3 ) + end if + call nextime( mdate, mtime, tstep( 1 ) ) + +#ifdef verbose_wbdust + sdiagv = sdiagv / float( wstep ) ! array assignment + write( logdev,2015 ) jdate, jtime + do v = 1, ndust_diag + if ( diagnm( v )%var(1:4) .ne. 'ANUM' ) then + write( logdev,2019 ) v, diagnm( v )%var, sdiagv( v ) + else + write( logdev,2023 ) v, diagnm( v )%var, sdiagv( v ) + end if + end do + sdiagv = 0.0 ! array assignment +#endif + do v = 1, ndust_diag + do r = 1, my_nrows + do c = 1, my_ncols + wrbuf( c,r ) = dustbf( v,c,r ) / float( wstep ) + end do + end do + + if ( .not. WRITE3( ctm_dust_emis_1, diagnm( v )%var, + & mdate, mtime, wrbuf ) ) then + xmsg = 'Could not write ' // trim( diagnm( v )%var ) + & // ' to CTM_DUST_EMIS_1' + call m3exit( pname, mdate, mtime, xmsg, xstat1 ) + end if + end do + write( logdev,'( /5x, 2( a, 1x ), i8, ":", i6.6 )' ) + & 'Timestep written to CTM_DUST_EMIS_1', + & 'for date and time', mdate, mtime + wstep = 0 + dustbf = 0.0 ! array assignment + end if ! time to write + end if ! dustem_diag + +2009 Format( '*** Erodible landuse incorrect ', 1pe13.5, 1x, 'at: ', 3i4 ) +2015 format( /5x, 'Total grid time-avg sum of dust emis variables at:', + & 1x, i8, ":", I6.6 ) +2019 format( i10, 1x, a, f20.5 ) +2023 format( i10, 1x, a, e20.3 ) + + end subroutine get_dust_emis + +C======================================================================= + function dust_hflux( ndp, dp, soiltxt, fmoit, fruf, ustr, sd_ep, dens ) + & result( hflux ) + +C usage: hflux = dust_flux( ndp, dp, +C soiltxt( j,: ), +C fmoit( c,r ), +C fruf( c,r,m ), +C ustr( c,r,m ), +C sd_ep( c,r ), +C dens( c,r ) ) + + implicit none + + include SUBST_CONST ! for grav + + integer, intent( in ) :: ndp + real, intent( in ) :: dp( ndp ) + real, intent( in ) :: soiltxt( ndp ) + real, intent( in ) :: fmoit, fruf, ustr, sd_ep, dens + real hflux + + real, parameter :: amen = 1.0 ! Marticorena and Bergametti [JGR,1997] + real, parameter :: cfac = 1000.0 * amen / grav + real, parameter :: A = 260.60061 ! 0.0123 * 2650.0 * 9.81 / 1.227 + real, parameter :: B = 1.6540342e-06 ! 0.0123 * 0.000165 / 1.227 + real utstar ! threshold U* [m/s] + real utem ! U term [(m/s)**3] + real fac + integer n + +! I can't initialize dp this way - it has to be passed in since ndp is variable + +C---Mean mass median diameter (m) for each soil texture +C [Chatenet et al., Sedimentology 1996 and Menut et al., JGR 2013] +! real :: dp( ndp ) = +! & (/ 690.0E-6, ! Coarse sand +! & 210.0E-6, ! Fine-medium sand +! & 125.0E-6, ! Silt +! & 2.0E-6 /) ! Clay + + fac = cfac * dens * sd_ep + utem = 0.0 + utstar = 0.0 + hflux = 0.0 + do n = 1, ndp ! loop over dust particle size +! utstar = sqrt( 0.0123 * ( 2650.0 * 9.81 * dp( n ) / 1.227 + 0.000165 +! / 1.227 / dp( n ) ) ) ! X roughness & moisture effects + utstar = sqrt( A * dp( n ) + B / dp( n ) ) * fmoit * fruf !Shao and Lu [JGR,2000] + if ( ustr .gt. utstar ) then ! wind erosion occurs only if U* > U*t +C---Horiz. Flux from White (1979) + utem = ( ustr + utstar ) * ( ustr * ustr - utstar * utstar ) +C---Horiz. Flux from Owen (1964) +! utem = ustr * ( ustr * ustr - utstar * utstar ) + hflux = hflux + & + fac * utem * soiltxt( n ) ! [g/m/s] + end if + end do ! dust particle size + + end function dust_hflux + +C============================================================================== + function dust_volumetric_to_gravimetric(vsoilm,clay,sand) + & result ( gwc ) +C usage: H = dust_volumetric_to_gravimetric(vsoilm(c,r), +C clay(c,r), +C sand(c,r)) + + implicit none + ! INPUTS + real, intent(in) :: vsoilm ! volumetric soil moisture + real, intent(in) :: clay ! clay fraction (0 -> 1) + real, intent(in) :: sand ! sand fraction (0 -> 1) + ! OUTPUTS + real :: H + ! LOCAL + real :: gwc ! gravimetric soil moisture + real :: bulk_dens_dry ! bulk density + real :: limit ! fecan soil moisture limit + real :: wsat ! saturated volumentric water content + real :: mpot ! saturated soil matric potential + + ! parameters + real*8, parameter :: bulk_dens = 2650.0d0 + real*8, parameter :: h20_dens = 1000.0d0 + + ! saturated soil matric potential [ mm H2O ] + mpot = 10.d0 * (10.0d0 ** (1.88d0 - 0.0131d0 * sand )) + + ! saturated volumentric water content [ m3 m-3 ] + wsat = 0.489d0 - 0.00126d0 * sand + + ! Bulk density of dry surface soil [kg m-3] + bulk_dens_dry = bulk_dens * ( 1.0d0 - wsat) + + ! Gravimetric water content [ kg kg-1] + gwc = VSOILM * h20_dens / bulk_dens_dry + if (gwc.ge.1.0e10) then + gwc = 0.d0 + endif + + end function dust_volumetric_to_gravimetric + +C======================================================================= + function dust_hflux_fengsha( ustar, fmoit, drag, uthr, ssm, dens ) + & result( hflux ) + +C hflux = dust_hflux( Met_Data%ustar( c,r), +C & fmoit( c,r ), +C & drag( c,r ), +C & uthr( c,r ), +C & ssm( c,r ), +C & Met_Data%dens1( c,r ) ) + + implicit none + + include SUBST_CONST ! for grav + + real, intent( in ) :: ustar, fmoit, drag, uthr, ssm, dens + real hflux + real rustar + real u_sum + real u_thresh + real fac + + real, parameter :: amen = 1.0 ! Marticorena and Bergametti [JGR,1997] + real, parameter :: cfac = 1000.0 * amen / grav + + fac = cfac * dens + hflux = 0.0 + + rustar = ustar * drag + u_thresh = uthr * fmoit + u_sum = rustar * u_thresh + + + hflux = max(0., rustar - u_thresh) * u_sum * u_sum * fac * ssm + + end function dust_hflux_fengsha + + end module dust_emis + diff --git a/src/model/src/centralized_io_util_module.F b/src/model/src/centralized_io_util_module.F new file mode 100644 index 0000000..f5b0653 --- /dev/null +++ b/src/model/src/centralized_io_util_module.F @@ -0,0 +1,282 @@ + +!------------------------------------------------------------------------! +! The Community Multiscale Air Quality (CMAQ) system software is in ! +! continuous development by various groups and is based on information ! +! from these groups: Federal Government employees, contractors working ! +! within a United States Government contract, and non-Federal sources ! +! including research institutions. These groups give the Government ! +! permission to use, prepare derivative works of, and distribute copies ! +! of their work in the CMAQ system to the public and to permit others ! +! to do so. The United States Environmental Protection Agency ! +! therefore grants similar permission to use the CMAQ system software, ! +! but users are requested to provide copies of derivative works or ! +! products designed to operate in the CMAQ system to the United States ! +! Government without restrictions as to use by others. Software ! +! that is used with the CMAQ system but distributed under the GNU ! +! General Public License or the GNU Lesser General Public License is ! +! subject to their copyright restrictions. ! +!------------------------------------------------------------------------! + +!------------------------------------------------------------------------! +! This module contains utility functions to support centralized I/O +! implementation + +! Revision History: +! 02/01/19, D. Wong: initial implementation +! 08/01/19, D. Wong: modified code to work with two-way model +! 11/20/19, F. Sidi: Modified time to sec to handle negative numbers +!------------------------------------------------------------------------! + + module centralized_io_util_module + + implicit none + + interface quicksort + module procedure quicksort1d, + & quicksort2d + end interface + + contains + +! ------------------------------------------------------------------------- + recursive subroutine quicksort1d (name, begin, end) + + character (*), intent(out) :: name(:) + integer, intent(in) :: begin, end + + integer :: i, j + character (50) :: str1, str2 + logical :: done + + str1 = name( (begin + end) / 2 ) + i = begin + j = end + done = .false. + do while (.not. done) + do while (name(i) < str1) + i = i + 1 + end do + do while (str1 < name(j)) + j = j - 1 + end do + if (i .ge. j) then + done = .true. + else + str2 = name(i) + name(i) = name(j) + name(j) = str2 + i = i + 1 + j = j - 1 + end if + end do + if (begin < i-1) call quicksort(name, begin, i-1) + if (j+1 < end) call quicksort(name, j+1, end) + + end subroutine quicksort1d + +! ------------------------------------------------------------------------- + recursive subroutine quicksort2d (name, begin, end) + + character (*), intent(out) :: name(:,:) + integer, intent(in) :: begin, end + + integer :: i, j, dsize + character (50) :: str1, str2(3) + logical :: done + + dsize = size(name,2) + str1 = name( (begin + end) / 2, 1 ) + i = begin + j = end + done = .false. + do while (.not. done) + do while (name(i,1) < str1) + i = i + 1 + end do + do while (str1 < name(j, 1)) + j = j - 1 + end do + if (i .ge. j) then + done = .true. + else + str2(1:dsize) = name(i,:) + name(i,:) = name(j,:) + name(j,:) = str2(1:dsize) + i = i + 1 + j = j - 1 + end if + end do + if (begin < i-1) call quicksort(name, begin, i-1) + if (j+1 < end) call quicksort(name, j+1, end) + + end subroutine quicksort2d + +! ------------------------------------------------------------------------- + function binary_search (name, list, n) result (loc) + + character (*), intent(in) :: name, list(:) + integer, intent(in) :: n + integer :: loc + + logical :: found + integer :: mid_loc, start_loc, end_loc + + start_loc = 1 + end_loc = n + found = .false. + do while ((start_loc .le. end_loc) .and. (.not. found)) + mid_loc = start_loc + (end_loc - start_loc) / 2 + if (name .lt. list(mid_loc)) then + end_loc = mid_loc - 1 + else if (name .gt. list(mid_loc)) then + start_loc = mid_loc + 1 + else + found = .true. + end if + end do + + if (found) then + loc = mid_loc + else + loc = -1 + end if + + end function binary_search + +! ------------------------------------------------------------------------- + function search (name, list, n) result (loc) + + character (*), intent(in) :: name, list(:) + integer, intent(in) :: n + integer :: loc + + logical :: found + integer :: lloc + + lloc = 0 + found = .false. + do while ((lloc .le. n) .and. (.not. found)) + lloc = lloc + 1 + if (name .eq. list(lloc)) then + found = .true. + end if + end do + + if (found) then + loc = lloc + else + loc = -1 + end if + + end function search + +! ------------------------------------------------------------------------- + integer function time_to_sec (time) + + integer, intent(in) :: time + integer :: neg_time + integer :: time_in_sec, hr, min, sec + + if (time .gt. 0) then + hr = time / 10000 + min = mod(time/100, 100) + sec = mod(time, 100) + time_to_sec = hr * 3600 + min * 60 + sec + else + neg_time = abs(time) + hr = neg_time / 10000 + min = mod(neg_time/100, 100) + sec = mod(neg_time, 100) + time_to_sec = -1*(hr * 3600 + min * 60 + sec) + end if + + end function time_to_sec + +! ------------------------------------------------------------------------- + integer function time_diff (time1, time2) + + integer, intent(in) :: time1, time2 + + time_diff = time_to_sec(time1) - time_to_sec(time2) + + end function time_diff + +!-------------------------------------------------------------------------- + integer function next_day (jday) + +! This function determermins the next day for time interpolation + implicit none + + integer, intent(in) :: jday + integer year, day + + day = MOD(jday,1000) + year = INT(jday/1000) + + If( day .LT. 365 ) Then + next_day = jday+1 + Else + If( MOD(year,4) .Eq. 0 .And. MOD(year,100) .Ne. 0 ) Then +! Leap Year + If( day .Eq. 365 ) Then + next_day = jday + 1 + Else + next_day = (INT(jday/1000)+1)*1000+1 + End If + Else If(MOD(year,400) .Eq. 0 ) Then +! also a leap year, e.g. 2000 but not 2100 + If( day .Eq. 365 ) Then + next_day = jday + 1 + Else + next_day = (INT(jday/1000)+1)*1000+1 + End If + Else +! not a leap year + next_day = (INT(jday/1000)+1)*1000+1 + End If + End If + + end function next_day + +!-------------------------------------------------------------------------- + + function IntegrateTrapezoid(x, y) + !! Calculates the integral of an array y with respect to x using the trapezoid + !! approximation. Note that the mesh spacing of x does not have to be uniform. + real, intent(in) :: x(:) !! Variable x + real, intent(in) :: y(size(x)) !! Function y(x) + real :: IntegrateTrapezoid !! Integral ∫y(x)·dx + ! Integrate using the trapezoidal rule + associate(n => size(x)) + IntegrateTrapezoid = sum((y(1+1:n-0) + y(1+0:n-1))*(x(1+1:n-0) - x(1+0:n-1)))/2 + end associate + end function + +! --------------------------------------------------------------------------- + + function interp_linear1_internal(x,y,xout) result(yout) + !! Interpolates for the y value at the desired x value, + !! given x and y values around the desired point. + + implicit none + + real, intent(IN) :: x(2), y(2), xout + real :: yout + real :: alph + + if ( xout .lt. x(1) .or. xout .gt. x(2) ) then + write(*,*) "interp1: xout < x0 or xout > x1 !" + write(*,*) "xout = ",xout + write(*,*) "x0 = ",x(1) + write(*,*) "x1 = ",x(2) + stop + end if + + alph = (xout - x(1)) / (x(2) - x(1)) + yout = y(1) + alph*(y(2) - y(1)) + + return + + end function interp_linear1_internal + + end module centralized_io_util_module From 1abdda056abb38083f9425d4ed38a88b37af3aea Mon Sep 17 00:00:00 2001 From: bbakernoaa Date: Wed, 3 Aug 2022 14:09:57 +0000 Subject: [PATCH 36/72] updates --- src/shr/aqm_config_mod.F90 | 16 +++++++++++ src/shr/aqm_emis_mod.F90 | 7 +++++ src/shr/aqm_methods.F90 | 57 +++++++++++++++++++++++++++++++++++--- 3 files changed, 76 insertions(+), 4 deletions(-) diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index c9ddc1a..9f75340 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -35,6 +35,7 @@ module aqm_config_mod logical :: ctm_wb_dust = .false. logical :: init_conc = .false. logical :: run_aero = .false. + logical :: fengsha_yn = .false. logical :: verbose = .false. type(aqm_species_type), pointer :: species => null() end type aqm_config_type @@ -193,6 +194,14 @@ subroutine aqm_config_read(model, config, rc) rcToReturn=rc)) & return ! bail out + call ESMF_ConfigGetAttribute(cf, config % fengsha_yn, & + label="fengsha_yn:", default=.false., rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) & + return ! bail out + ! -- set other default values config % ctm_depvfile = .false. config % ctm_photodiag = .false. @@ -496,6 +505,13 @@ subroutine aqm_config_log(config, name, rc) call ESMF_LogWrite(trim(name) // ": config: read: ctm_wb_dust: false", & ESMF_LOGMSG_INFO, rc=localrc) end if + if (config % fengsha_yn) then + call ESMF_LogWrite(trim(name) // ": config: read: fengsha_yn: true", & + ESMF_LOGMSG_INFO, rc=localrc) + else + call ESMF_LogWrite(trim(name) // ": config: read: fengsha_yn: false", & + ESMF_LOGMSG_INFO, rc=localrc) + end if if (config % run_aero) then call ESMF_LogWrite(trim(name) // ": config: read: run_aerosol: true", & ESMF_LOGMSG_INFO, rc=localrc) diff --git a/src/shr/aqm_emis_mod.F90 b/src/shr/aqm_emis_mod.F90 index 5590ef1..a8dbcee 100644 --- a/src/shr/aqm_emis_mod.F90 +++ b/src/shr/aqm_emis_mod.F90 @@ -1160,6 +1160,13 @@ subroutine aqm_emis_read(etype, spcname, buffer, localDe, rc) if (present(rc)) rc = AQM_RC_FAILURE return ! bail out end if + + if (trim(em % type) == "fengsha") then + ! -- ensure fengsha variables are not normalized by area like + ! -- emissions conversions below + em % dens_flag(item) = 1 + end if + select case (em % dens_flag(item)) case (:-1) ! -- this case indicates that input emissions are provided as totals/cell diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index f4c4a8f..f82fc4f 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -148,7 +148,7 @@ LOGICAL FUNCTION DESC3( FNAME ) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_2D ) ) THEN - NVARS3D = 31 + NVARS3D = 35 VNAME3D( 1:NVARS3D ) = & (/ 'PRSFC ', 'USTAR ', & 'WSTAR ', 'PBL ', & @@ -165,7 +165,9 @@ LOGICAL FUNCTION DESC3( FNAME ) 'SLTYP ', 'Q2 ', & 'SEAICE ', 'SOIM1 ', & 'SOIM2 ', 'SOIT1 ', & - 'SOIT2 ', 'LH ' /) + 'SOIT2 ', 'LH ', & + 'CLAYF ', 'SANDF ', & + 'DRAG ', 'UTHR ' /) UNITS3D( 1:NVARS3D ) = & (/ 'Pascal ', 'M/S ', & 'M/S ', 'M ', & @@ -182,7 +184,9 @@ LOGICAL FUNCTION DESC3( FNAME ) '- ', 'KG/KG ', & 'FRACTION ', 'M**3/M**3 ', & 'M**3/M**3 ', 'K ', & - 'K ', 'WATTS/M**2 ' /) + 'K ', 'WATTS/M**2 ', & + '- ', '- ', & + '- ', 'M/S ' /) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN @@ -330,6 +334,10 @@ logical function envyn(name, description, defaultval, status) envyn = associated(em) case ('CTM_GRAV_SETL') envyn = .false. + case ('CTM_FENGSHA') + write(*,*) 'CTM_FENGSHA CONFIG SET' + envyn = config % fengsha_yn ! Default: False + envyn = .true. case ('INITIAL_RUN') envyn = .true. case default @@ -736,7 +744,48 @@ logical function interpx( fname, vname, pname, & buffer(k) = 0.01 * stateIn % zorl(c,r) end do end do - case default + case ("CLAYF") + ! p2d -> stateIn % clayf + if (config % fengsha_yn) then + write(*,*) 'FENGSHA CONFIG READ' + call aqm_emis_read("fengsha", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read fengsha for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0 + endif + case ("SANDF") + ! p2d -> stateIn % clayf + if (config % fengsha_yn) then + call aqm_emis_read("fengsha", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read fengsha for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0 + endif + case ("DRAG") + ! p2d -> stateIn % clayf + if (config % fengsha_yn) then + call aqm_emis_read("fengsha", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read fengsha for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0 + endif + case ("UTHR") + ! p2d -> stateIn % clayf + if (config % fengsha_yn) then + call aqm_emis_read("fengsha", vname, buffer, rc=localrc) + if (aqm_rc_test((localrc /= 0), & + msg="Failure to read fengsha for " // vname, & + file=__FILE__, line=__LINE__)) return + else + buffer(1:lbuf) = 0 + endif + case default ! return end select From 11c22626d5da6655be3b0f403e8dcae3511353c2 Mon Sep 17 00:00:00 2001 From: bbakernoaa Date: Wed, 3 Aug 2022 14:30:50 +0000 Subject: [PATCH 37/72] Revert "updates" This reverts commit 1abdda056abb38083f9425d4ed38a88b37af3aea. --- src/shr/aqm_config_mod.F90 | 16 ----------- src/shr/aqm_emis_mod.F90 | 7 ----- src/shr/aqm_methods.F90 | 57 +++----------------------------------- 3 files changed, 4 insertions(+), 76 deletions(-) diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index 9f75340..c9ddc1a 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -35,7 +35,6 @@ module aqm_config_mod logical :: ctm_wb_dust = .false. logical :: init_conc = .false. logical :: run_aero = .false. - logical :: fengsha_yn = .false. logical :: verbose = .false. type(aqm_species_type), pointer :: species => null() end type aqm_config_type @@ -194,14 +193,6 @@ subroutine aqm_config_read(model, config, rc) rcToReturn=rc)) & return ! bail out - call ESMF_ConfigGetAttribute(cf, config % fengsha_yn, & - label="fengsha_yn:", default=.false., rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc)) & - return ! bail out - ! -- set other default values config % ctm_depvfile = .false. config % ctm_photodiag = .false. @@ -505,13 +496,6 @@ subroutine aqm_config_log(config, name, rc) call ESMF_LogWrite(trim(name) // ": config: read: ctm_wb_dust: false", & ESMF_LOGMSG_INFO, rc=localrc) end if - if (config % fengsha_yn) then - call ESMF_LogWrite(trim(name) // ": config: read: fengsha_yn: true", & - ESMF_LOGMSG_INFO, rc=localrc) - else - call ESMF_LogWrite(trim(name) // ": config: read: fengsha_yn: false", & - ESMF_LOGMSG_INFO, rc=localrc) - end if if (config % run_aero) then call ESMF_LogWrite(trim(name) // ": config: read: run_aerosol: true", & ESMF_LOGMSG_INFO, rc=localrc) diff --git a/src/shr/aqm_emis_mod.F90 b/src/shr/aqm_emis_mod.F90 index a8dbcee..5590ef1 100644 --- a/src/shr/aqm_emis_mod.F90 +++ b/src/shr/aqm_emis_mod.F90 @@ -1160,13 +1160,6 @@ subroutine aqm_emis_read(etype, spcname, buffer, localDe, rc) if (present(rc)) rc = AQM_RC_FAILURE return ! bail out end if - - if (trim(em % type) == "fengsha") then - ! -- ensure fengsha variables are not normalized by area like - ! -- emissions conversions below - em % dens_flag(item) = 1 - end if - select case (em % dens_flag(item)) case (:-1) ! -- this case indicates that input emissions are provided as totals/cell diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index f82fc4f..f4c4a8f 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -148,7 +148,7 @@ LOGICAL FUNCTION DESC3( FNAME ) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_2D ) ) THEN - NVARS3D = 35 + NVARS3D = 31 VNAME3D( 1:NVARS3D ) = & (/ 'PRSFC ', 'USTAR ', & 'WSTAR ', 'PBL ', & @@ -165,9 +165,7 @@ LOGICAL FUNCTION DESC3( FNAME ) 'SLTYP ', 'Q2 ', & 'SEAICE ', 'SOIM1 ', & 'SOIM2 ', 'SOIT1 ', & - 'SOIT2 ', 'LH ', & - 'CLAYF ', 'SANDF ', & - 'DRAG ', 'UTHR ' /) + 'SOIT2 ', 'LH ' /) UNITS3D( 1:NVARS3D ) = & (/ 'Pascal ', 'M/S ', & 'M/S ', 'M ', & @@ -184,9 +182,7 @@ LOGICAL FUNCTION DESC3( FNAME ) '- ', 'KG/KG ', & 'FRACTION ', 'M**3/M**3 ', & 'M**3/M**3 ', 'K ', & - 'K ', 'WATTS/M**2 ', & - '- ', '- ', & - '- ', 'M/S ' /) + 'K ', 'WATTS/M**2 ' /) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN @@ -334,10 +330,6 @@ logical function envyn(name, description, defaultval, status) envyn = associated(em) case ('CTM_GRAV_SETL') envyn = .false. - case ('CTM_FENGSHA') - write(*,*) 'CTM_FENGSHA CONFIG SET' - envyn = config % fengsha_yn ! Default: False - envyn = .true. case ('INITIAL_RUN') envyn = .true. case default @@ -744,48 +736,7 @@ logical function interpx( fname, vname, pname, & buffer(k) = 0.01 * stateIn % zorl(c,r) end do end do - case ("CLAYF") - ! p2d -> stateIn % clayf - if (config % fengsha_yn) then - write(*,*) 'FENGSHA CONFIG READ' - call aqm_emis_read("fengsha", vname, buffer, rc=localrc) - if (aqm_rc_test((localrc /= 0), & - msg="Failure to read fengsha for " // vname, & - file=__FILE__, line=__LINE__)) return - else - buffer(1:lbuf) = 0 - endif - case ("SANDF") - ! p2d -> stateIn % clayf - if (config % fengsha_yn) then - call aqm_emis_read("fengsha", vname, buffer, rc=localrc) - if (aqm_rc_test((localrc /= 0), & - msg="Failure to read fengsha for " // vname, & - file=__FILE__, line=__LINE__)) return - else - buffer(1:lbuf) = 0 - endif - case ("DRAG") - ! p2d -> stateIn % clayf - if (config % fengsha_yn) then - call aqm_emis_read("fengsha", vname, buffer, rc=localrc) - if (aqm_rc_test((localrc /= 0), & - msg="Failure to read fengsha for " // vname, & - file=__FILE__, line=__LINE__)) return - else - buffer(1:lbuf) = 0 - endif - case ("UTHR") - ! p2d -> stateIn % clayf - if (config % fengsha_yn) then - call aqm_emis_read("fengsha", vname, buffer, rc=localrc) - if (aqm_rc_test((localrc /= 0), & - msg="Failure to read fengsha for " // vname, & - file=__FILE__, line=__LINE__)) return - else - buffer(1:lbuf) = 0 - endif - case default + case default ! return end select From 9b8d2e07af34fe5c7edf50276da808d583c6c82b Mon Sep 17 00:00:00 2001 From: bbakernoaa Date: Wed, 3 Aug 2022 14:31:04 +0000 Subject: [PATCH 38/72] Revert "updates" This reverts commit 43588af77cf86ee9f24cc67437d625d0ebede984. --- aqm_files.cmake | 6 +- src/model/Makefile.am | 64 +- src/model/Makefile.in | 109 +- src/model/src/ASX_DATA_MOD.F | 1463 ------------------- src/model/src/ASX_DATA_MOD.F~ | 1459 ------------------- src/model/src/DUST_EMIS.F | 1525 -------------------- src/model/src/centralized_io_util_module.F | 282 ---- 7 files changed, 80 insertions(+), 4828 deletions(-) delete mode 100755 src/model/src/ASX_DATA_MOD.F delete mode 100755 src/model/src/ASX_DATA_MOD.F~ delete mode 100644 src/model/src/DUST_EMIS.F delete mode 100644 src/model/src/centralized_io_util_module.F diff --git a/aqm_files.cmake b/aqm_files.cmake index 22bd6af..c3f7420 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -130,6 +130,7 @@ list(APPEND aqm_CCTM_files ${EMIS}/BEIS_DEFN.F ${EMIS}/BIOG_EMIS.F ${EMIS}/cropcal.F + ${EMIS}/DUST_EMIS.F ${EMIS}/EMIS_DEFN.F ${EMIS}/LTNG_DEFN.F ${EMIS}/LUS_DEFN.F @@ -214,6 +215,7 @@ list(APPEND aqm_CCTM_files ${UTIL}/subhdomain.F ${UTIL}/UTILIO_DEFN.F ${VDIFF}/aero_sedv.F + ${VDIFF}/ASX_DATA_MOD.F ${VDIFF}/conv_cgrid.F ${VDIFF}/matrix1.F ${VDIFF}/opddep.F @@ -229,8 +231,4 @@ list(APPEND aqm_CCTM_files ${localCCTM}/vdiffacmx.F ${localCCTM}/PTMAP.F ${localCCTM}/PT3D_DEFN.F - ${localCCTM}/ASX_DATA_MOD.F - ${localCCTM}/centralized_io_util_module.F - ${localCCTM}/DUST_EMIS.F ) - diff --git a/src/model/Makefile.am b/src/model/Makefile.am index 909b66e..61c4887 100644 --- a/src/model/Makefile.am +++ b/src/model/Makefile.am @@ -79,6 +79,7 @@ libCCTM_a_SOURCES += \ $(EMIS)/BEIS_DEFN.F \ $(EMIS)/BIOG_EMIS.F \ $(EMIS)/cropcal.F \ + $(EMIS)/DUST_EMIS.F \ $(EMIS)/EMIS_DEFN.F \ $(EMIS)/LTNG_DEFN.F \ $(EMIS)/LUS_DEFN.F \ @@ -222,6 +223,7 @@ VDIFF = $(CCTM)/vdiff/acm2 libVDIFF = $(VDIFF)/$(libCCTM)- libCCTM_a_SOURCES += \ $(VDIFF)/aero_sedv.F \ + $(VDIFF)/ASX_DATA_MOD.F \ $(VDIFF)/conv_cgrid.F \ $(VDIFF)/matrix1.F \ $(VDIFF)/opddep.F \ @@ -240,11 +242,7 @@ libCCTM_a_SOURCES += \ $(localCCTM)/o3totcol.f \ $(localCCTM)/vdiffacmx.F \ $(localCCTM)/PTMAP.F \ - $(localCCTM)/PT3D_DEFN.F \ - $(localCCTM)/ASX_DATA_MOD.F \ - $(localCCTM)/centralized_io_util_module.F \ - $(localCCTM)/DUST_EMIS.F - + $(localCCTM)/PT3D_DEFN.F libCCTM_a_CPPFLAGS = -DSUBST_FILES_ID=\"FILES_CTM.EXT\" @@ -291,7 +289,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -303,8 +301,8 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(liblocalCCTM)DUST_EMIS.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) \ @@ -320,7 +318,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -349,11 +347,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -370,7 +368,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -380,7 +378,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -389,13 +387,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -407,7 +405,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -422,9 +420,13 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -437,7 +439,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -450,7 +452,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -459,7 +461,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -618,8 +620,12 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -639,7 +645,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -651,7 +657,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -663,7 +669,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -673,11 +679,3 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(liblocalCCTM)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ - $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ - $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) diff --git a/src/model/Makefile.in b/src/model/Makefile.in index e6ef50a..0c12a88 100644 --- a/src/model/Makefile.in +++ b/src/model/Makefile.in @@ -143,6 +143,7 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(EMIS)/libCCTM_a-BEIS_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-BIOG_EMIS.$(OBJEXT) \ $(EMIS)/libCCTM_a-cropcal.$(OBJEXT) \ + $(EMIS)/libCCTM_a-DUST_EMIS.$(OBJEXT) \ $(EMIS)/libCCTM_a-EMIS_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-LTNG_DEFN.$(OBJEXT) \ $(EMIS)/libCCTM_a-LUS_DEFN.$(OBJEXT) \ @@ -221,6 +222,7 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(UTIL)/libCCTM_a-subhdomain.$(OBJEXT) \ $(UTIL)/libCCTM_a-UTILIO_DEFN.$(OBJEXT) \ $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT) \ + $(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT) \ $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT) \ $(VDIFF)/libCCTM_a-opddep.$(OBJEXT) \ @@ -235,10 +237,7 @@ am_libCCTM_a_OBJECTS = $(AERO)/libCCTM_a-AERO_DATA.$(OBJEXT) \ $(localCCTM)/libCCTM_a-o3totcol.$(OBJEXT) \ $(localCCTM)/libCCTM_a-vdiffacmx.$(OBJEXT) \ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT) \ - $(localCCTM)/libCCTM_a-DUST_EMIS.$(OBJEXT) + $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT) libCCTM_a_OBJECTS = $(am_libCCTM_a_OBJECTS) AM_V_P = $(am__v_P_@AM_V@) am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) @@ -469,7 +468,7 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(DEPV)/MOSAIC_MOD.F $(DEPV)/opdepv_diag.F \ $(DEPV)/opdepv_mos.F $(DEPV)/opdepv_fst.F $(DEPV)/m3dry.F \ $(EMIS)/BEIS_DEFN.F $(EMIS)/BIOG_EMIS.F $(EMIS)/cropcal.F \ - $(EMIS)/EMIS_DEFN.F $(EMIS)/LTNG_DEFN.F \ + $(EMIS)/DUST_EMIS.F $(EMIS)/EMIS_DEFN.F $(EMIS)/LTNG_DEFN.F \ $(EMIS)/LUS_DEFN.F $(EMIS)/MGEMIS.F $(EMIS)/opemis.F \ $(EMIS)/PTBILIN.F $(EMIS)/SSEMIS.F $(EMIS)/STK_EMIS.F \ $(EMIS)/STK_PRMS.F $(EMIS)/tfabove.F $(EMIS)/tfbelow.F \ @@ -505,15 +504,13 @@ libCCTM_a_SOURCES = $(AERO)/AERO_DATA.F $(AERO)/aero_depv.F \ $(STENEX)/noop_util_module.f $(UTIL)/bmatvec.F \ $(UTIL)/findex.f $(UTIL)/get_envlist.f $(UTIL)/setup_logdev.F \ $(UTIL)/subhdomain.F $(UTIL)/UTILIO_DEFN.F \ - $(VDIFF)/aero_sedv.F \ + $(VDIFF)/aero_sedv.F $(VDIFF)/ASX_DATA_MOD.F \ $(VDIFF)/conv_cgrid.F $(VDIFF)/matrix1.F $(VDIFF)/opddep.F \ $(VDIFF)/opddep_fst.F $(VDIFF)/opddep_mos.F $(VDIFF)/rddepv.F \ $(VDIFF)/SEDIMENTATION.F $(VDIFF)/tri.F $(VDIFF)/VDIFF_DIAG.F \ $(VDIFF)/VDIFF_MAP.F $(VDIFF)/vdiffproc.F \ $(localCCTM)/o3totcol.f $(localCCTM)/vdiffacmx.F \ - $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F \ - $(localCCTM)/ASX_DATA_MOD.F \ - $(localCCTM)/centralized_io_util_module.F $(localCCTM)/DUST_EMIS.F + $(localCCTM)/PTMAP.F $(localCCTM)/PT3D_DEFN.F # local version of CCTM source files localCCTM = $(builddir)/src @@ -760,6 +757,8 @@ $(EMIS)/libCCTM_a-BIOG_EMIS.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-cropcal.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) +$(EMIS)/libCCTM_a-DUST_EMIS.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ + $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-EMIS_DEFN.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ $(EMIS)/$(DEPDIR)/$(am__dirstamp) $(EMIS)/libCCTM_a-LTNG_DEFN.$(OBJEXT): $(EMIS)/$(am__dirstamp) \ @@ -982,6 +981,8 @@ $(VDIFF)/$(DEPDIR)/$(am__dirstamp): @: > $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-aero_sedv.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) +$(VDIFF)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ + $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-conv_cgrid.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ $(VDIFF)/$(DEPDIR)/$(am__dirstamp) $(VDIFF)/libCCTM_a-matrix1.$(OBJEXT): $(VDIFF)/$(am__dirstamp) \ @@ -1021,12 +1022,6 @@ $(localCCTM)/libCCTM_a-PTMAP.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/libCCTM_a-PT3D_DEFN.$(OBJEXT): \ $(localCCTM)/$(am__dirstamp) \ $(localCCTM)/$(DEPDIR)/$(am__dirstamp) -$(localCCTM)/libCCTM_a-ASX_DATA_MOD.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ - $(localCCTM)/$(DEPDIR)/$(am__dirstamp) -$(localCCTM)/libCCTM_a-centralized_io_util_module.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ - $(localCCTM)/$(DEPDIR)/$(am__dirstamp) -$(localCCTM)/libCCTM_a-DUST_EMIS.$(OBJEXT): $(localCCTM)/$(am__dirstamp) \ - $(localCCTM)/$(DEPDIR)/$(am__dirstamp) libCCTM.a: $(libCCTM_a_OBJECTS) $(libCCTM_a_DEPENDENCIES) $(EXTRA_libCCTM_a_DEPENDENCIES) $(AM_V_at)-rm -f libCCTM.a @@ -1278,13 +1273,11 @@ $(EMIS)/libCCTM_a-cropcal.o: $(EMIS)/cropcal.F $(EMIS)/libCCTM_a-cropcal.obj: $(EMIS)/cropcal.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-cropcal.obj `if test -f '$(EMIS)/cropcal.F'; then $(CYGPATH_W) '$(EMIS)/cropcal.F'; else $(CYGPATH_W) '$(srcdir)/$(EMIS)/cropcal.F'; fi` -$(localCCTM)/libCCTM_a-DUST_EMIS.o: $(localCCTM)/DUST_EMIS.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-DUST_EMIS.o `test -f '$(local -CCTM)/DUST_EMIS.F' || echo '$(srcdir)/'`$(localCCTM)/DUST_EMIS.F +$(EMIS)/libCCTM_a-DUST_EMIS.o: $(EMIS)/DUST_EMIS.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-DUST_EMIS.o `test -f '$(EMIS)/DUST_EMIS.F' || echo '$(srcdir)/'`$(EMIS)/DUST_EMIS.F -$(localCCTM)/libCCTM_a-DUST_EMIS.obj: $(localCCTM)/DUST_EMIS.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-DUST_EMIS.obj `if test -f '$( -localCCTM)/DUST_EMIS.F'; then $(CYGPATH_W) '$(localCCTM)/DUST_EMIS.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/DUST_EMIS.F'; fi` +$(EMIS)/libCCTM_a-DUST_EMIS.obj: $(EMIS)/DUST_EMIS.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-DUST_EMIS.obj `if test -f '$(EMIS)/DUST_EMIS.F'; then $(CYGPATH_W) '$(EMIS)/DUST_EMIS.F'; else $(CYGPATH_W) '$(srcdir)/$(EMIS)/DUST_EMIS.F'; fi` $(EMIS)/libCCTM_a-EMIS_DEFN.o: $(EMIS)/EMIS_DEFN.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(EMIS)/libCCTM_a-EMIS_DEFN.o `test -f '$(EMIS)/EMIS_DEFN.F' || echo '$(srcdir)/'`$(EMIS)/EMIS_DEFN.F @@ -1622,20 +1615,11 @@ $(VDIFF)/libCCTM_a-aero_sedv.o: $(VDIFF)/aero_sedv.F $(VDIFF)/libCCTM_a-aero_sedv.obj: $(VDIFF)/aero_sedv.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-aero_sedv.obj `if test -f '$(VDIFF)/aero_sedv.F'; then $(CYGPATH_W) '$(VDIFF)/aero_sedv.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/aero_sedv.F'; fi` -+$(localCCTM)/libCCTM_a-centralized_io_util_module.o: $(localCCTM)/centralized_io_util_module.F -+ $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.o -`test -f '$(localCCTM)/centralized_io_util_module.F' || echo '$(srcdir)/'`$(localCCTM)/centralized_io_util_module.F -+ -+$(localCCTM)/libCCTM_a-centralized_io_util_module.obj: $(localCCTM)/centralized_io_util_module.F -+ $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(localCCTM)/libCCTM_a-centralized_io_util_module.ob -j `if test -f '$(localCCTM)/centralized_io_util_module.F'; then $(CYGPATH_W) '$(localCCTM)/centralized_io_util_module.F'; else $(CYGPATH_W) '$(srcdir)/$(localCCTM)/centralized_io_util_module -.F'; fi` +$(VDIFF)/libCCTM_a-ASX_DATA_MOD.o: $(VDIFF)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(VDIFF)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(VDIFF)/ASX_DATA_MOD.F -$(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.o: $(liblocalCCTM)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.o `test -f '$(liblocalCCTM)/ASX_DATA_MOD.F' || echo '$(srcdir)/'`$(liblocalCCTM)/ASX_DATA_MOD.F - -$(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.obj: $(liblocalCCTM)/ASX_DATA_MOD.F - $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(liblocalCCTM)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(liblocalCCTM)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(liblocalCCTM)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(liblocalCCTM)/ASX_DATA_MOD.F'; fi` +$(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj: $(VDIFF)/ASX_DATA_MOD.F + $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-ASX_DATA_MOD.obj `if test -f '$(VDIFF)/ASX_DATA_MOD.F'; then $(CYGPATH_W) '$(VDIFF)/ASX_DATA_MOD.F'; else $(CYGPATH_W) '$(srcdir)/$(VDIFF)/ASX_DATA_MOD.F'; fi` $(VDIFF)/libCCTM_a-conv_cgrid.o: $(VDIFF)/conv_cgrid.F $(AM_V_PPF77)$(F77) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libCCTM_a_CPPFLAGS) $(CPPFLAGS) $(libCCTM_a_FFLAGS) $(FFLAGS) -c -o $(VDIFF)/libCCTM_a-conv_cgrid.o `test -f '$(VDIFF)/conv_cgrid.F' || echo '$(srcdir)/'`$(VDIFF)/conv_cgrid.F @@ -2180,7 +2164,7 @@ $(libAERO)AERO_DATA.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)aero_depv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2192,8 +2176,8 @@ $(libAERO)aero_driver.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libAERO)SOA_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ - $(libSPCS)CGRID_SPCS.$(OBJEXT) $(liblocalCCTM)DUST_EMIS.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libEMIS)DUST_EMIS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) $(liblocalCCTM)PTMAP.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) \ @@ -2209,7 +2193,7 @@ $(libAERO)aero_subs.$(OBJEXT) : $(ICL)/const/CONST.EXT $(AERO)/isrpia.inc \ $(libAERO)AOD_DEFN.$(OBJEXT) $(libAERO)PRECURSOR_DATA.$(OBJEXT) \ $(libAERO)SOA_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)AOD_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libAERO)getpar.$(OBJEXT) : \ @@ -2238,11 +2222,11 @@ $(libAERO)SOA_DEFN.$(OBJEXT) : \ # biog $(libBIOG)beis3.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libBIOG)czangle.$(OBJEXT) : $(ICL)/const/CONST.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)hrno.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BIOG_EMIS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libSTENEX)noop_modules.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libBIOG)parsline.$(OBJEXT) : \ @@ -2259,7 +2243,7 @@ $(libCLOUD)hlconst.$(OBJEXT) : \ # depv $(libDEPV)ABFLUX_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ @@ -2269,7 +2253,7 @@ $(libDEPV)cgrid_depv.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ $(libDEPV)MOSAIC_MOD.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ @@ -2278,13 +2262,13 @@ $(libDEPV)gas_depv_map.$(OBJEXT) : \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)opdepv_diag.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ @@ -2296,7 +2280,7 @@ $(libDEPV)opdepv_fst.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libDEPV)m3dry.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libDEPV)ABFLUX_MOD.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libDEPV)BIDI_MOD.$(OBJEXT) $(libDEPV)DEPVVARS.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libDEPV)HGSIM.$(OBJEXT) \ $(libDEPV)LSM_MOD.$(OBJEXT) $(libDEPV)MOSAIC_MOD.$(OBJEXT) \ @@ -2311,9 +2295,13 @@ $(libEMIS)BIOG_EMIS.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)cropcal.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(libEMIS)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ + $(libAERO)AERO_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ + $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AERO_EMIS.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libEMIS)BEIS_DEFN.$(OBJEXT) \ $(libEMIS)BIOG_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libEMIS)LTNG_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) \ @@ -2326,7 +2314,7 @@ $(libEMIS)LTNG_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libEMIS)LUS_DEFN.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)MGEMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AEROMET_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ + $(libAERO)AEROMET_DATA.$(OBJEXT) $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libGRID)PCGRID_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2339,7 +2327,7 @@ $(libEMIS)PTBILIN.$(OBJEXT) : \ $(libEMIS)UDTYPES.$(OBJEXT) $(libGRID)VGRD_DEFN.$(OBJEXT) $(libEMIS)SSEMIS.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)STK_EMIS.$(OBJEXT) : \ @@ -2348,7 +2336,7 @@ $(libEMIS)STK_PRMS.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)UDTYPES.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libEMIS)tfabove.$(OBJEXT) : \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libEMIS)LUS_DEFN.$(OBJEXT) $(libEMIS)tfbelow.$(OBJEXT) : \ $(libGRID)HGRD_DEFN.$(OBJEXT) $(libEMIS)LUS_DEFN.$(OBJEXT) \ @@ -2507,8 +2495,12 @@ $(libUTIL)subhdomain.$(OBJEXT) : \ # vdiff $(libVDIFF)aero_sedv.$(OBJEXT) : \ $(libAERO)AERO_DATA.$(OBJEXT) $(libAERO)AEROMET_DATA.$(OBJEXT) \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) +$(libVDIFF)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ + $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ + $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ + $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)conv_cgrid.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) @@ -2528,7 +2520,7 @@ $(libVDIFF)rddepv.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)SEDIMENTATION.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_DIAG.$(OBJEXT) $(libVDIFF)VDIFF_MAP.$(OBJEXT) $(libVDIFF)tri.$(OBJEXT) : \ @@ -2540,7 +2532,7 @@ $(libVDIFF)VDIFF_MAP.$(OBJEXT) : $(ICL)/emctrl/EMISPRM.EXT \ $(libAERO)AERO_EMIS.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) \ $(libEMIS)EMIS_DEFN.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ $(libDEPV)HGSIM.$(OBJEXT) $(libDEPV)LSM_MOD.$(OBJEXT) \ @@ -2552,7 +2544,7 @@ $(libVDIFF)vdiffproc.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ $(liblocalCCTM)o3totcol.$(OBJEXT) : \ $(libUTIL)UTILIO_DEFN.$(OBJEXT) $(liblocalCCTM)vdiffacmx.$(OBJEXT) : $(ICL)/filenames/FILES_CTM.EXT \ - $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ + $(libVDIFF)ASX_DATA_MOD.$(OBJEXT) $(libDEPV)BIDI_MOD.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(libSPCS)CGRID_SPCS.$(OBJEXT) $(libDEPV)DEPV_DEFN.$(OBJEXT) $(libEMIS)EMIS_DEFN.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) \ $(libVDIFF)VDIFF_MAP.$(OBJEXT) @@ -2562,14 +2554,7 @@ $(liblocalCCTM)PT3D_DEFN.$(OBJEXT) : $(libAERO)AERO_DATA.$(OBJEXT) \ $(libGRID)GRID_CONF.$(OBJEXT) $(libSPCS)CGRID_SPCS.$(OBJEXT) \ $(liblocalCCTM)PTMAP.$(OBJEXT) $(libMECHS)RXNS_DATA_MODULE.$(OBJEXT) \ $(libEMIS)STK_EMIS.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT $(ICL)/mpi/PE_COMM.EXT \ - $(libDEPV)DEPVVARS.$(OBJEXT) $(libGRID)GRID_CONF.$(OBJEXT) \ - $(libDEPV)LSM_MOD.$(OBJEXT) $(libSTENEX)noop_modules.$(OBJEXT) \ - $(libUTIL)UTILIO_DEFN.$(OBJEXT) -$(liblocalCCTM)DUST_EMIS.$(OBJEXT) : $(ICL)/const/CONST.EXT $(ICL)/filenames/FILES_CTM.EXT \ - $(libAERO)AERO_DATA.$(OBJEXT) $(liblocalCCTM)ASX_DATA_MOD.$(OBJEXT) \ - $(libGRID)GRID_CONF.$(OBJEXT) $(libGRID)HGRD_DEFN.$(OBJEXT) \ - $(libEMIS)LUS_DEFN.$(OBJEXT) $(libUTIL)UTILIO_DEFN.$(OBJEXT) + # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F deleted file mode 100755 index 160183f..0000000 --- a/src/model/src/ASX_DATA_MOD.F +++ /dev/null @@ -1,1463 +0,0 @@ -!------------------------------------------------------------------------! -! The Community Multiscale Air Quality (CMAQ) system software is in ! -! continuous development by various groups and is based on information ! -! from these groups: Federal Government employees, contractors working ! -! within a United States Government contract, and non-Federal sources ! -! including research institutions. These groups give the Government ! -! permission to use, prepare derivative works of, and distribute copies ! -! of their work in the CMAQ system to the public and to permit others ! -! to do so. The United States Environmental Protection Agency ! -! therefore grants similar permission to use the CMAQ system software, ! -! but users are requested to provide copies of derivative works or ! -! products designed to operate in the CMAQ system to the United States ! -! Government without restrictions as to use by others. Software ! -! that is used with the CMAQ system but distributed under the GNU ! -! General Public License or the GNU Lesser General Public License is ! -! subject to their copyright restrictions. ! -!------------------------------------------------------------------------! - -C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - Module ASX_DATA_MOD - -C----------------------------------------------------------------------- -C Function: User-defined types - -C Revision History: -C 19 Aug 2014 J.Bash: initial implementation -C 17 July 2015 H.Foroutan: Updated the calculation of MOL, MOLI, HOL, and WSTAR -C 25 Aug 2015 H. Pye: Added IEPOX, HACET surrogates -C modified PROPNN and H2O2 -C Increased ar for ozone from 8 to 12. -C Change meso from 0.1 to 0 for some org. nitrates -C Changes based on Nguyen et al. 2015 PNAS and SOAS -C -C---------Notes -C * Updates based on literature review 7/96 JEP -C # Diff and H based on Wesely (1988) same as RADM -C + Estimated by JEP 2/97 -C @ Updated by JEP 9/01 -C ~ Added by YW 1/02. Dif0 based on Massman (1998). Henry's Law constant -C is defined here as: h=cg/ca, where cg is the concentration of a species -C in gas-phase, and ca is its aqueous-phase concentration. The smaller h, -C the larger solubility. Henry's Law constant in another definition (KH): -C KH = ca/pg [M/atm], KH = KH0 * exp(-DKH/R(1/T-1/T0)), where KH0 and -DKH -C values are from Rolf Sander (1999). h=1/(KH*R*T). -C ** Update by DBS based on estimates by JEP 1/03 -C ^^ From Bill Massman, personal communication 4/03 -C ## Diffusivity calculated by SPARC, reactivity = other aldehydes -C ++ Dif0 in Massman is diffusivity at temperature 0C and 1 atm (101.325kPa), so -C chemicals that were not in Massman's paper need to be adjusted. We assume -C JEP's original values were for 25C and 1 atm. -C % Added by G. Sarwar (10/04) -C $ Added by R. Bullock (02/05) HG diffusivity is from Massman (1999). -C HGIIGAS diffusivity calculated from the HG value and a mol. wt. scaling -C factor of MW**(-2/3) from EPA/600/3-87/015. ORD, Athens, GA. HGIIGAS -C mol.wt. used is that of HgCl2. Reactivity of HG is 1/20th of NO and NO2 -C values based on general atmospheric lifetimes of each species. Reactivity -C of HGIIGAS is based on HNO3 surrogate. -C @@ Mesophyll resistances for NO, NO2, and CO added by J. Pleim (07/07) based -C on values in Pleim, Venkatram, and Yamartino, 1984: ADOM/TADAP Model -C Development Program, Volume 4, The Dry Deposition Module. ERT, Inc., -C Concord, MA (peer reviewed). -C ~~ Reactivity for PAN changed from 4.0 to 16.0 by J. Pleim (07/07) based on -C comparisons with Turnipseed et al., JGR, 2006. -C %% Species ICL1 and ICL2 are removed, not used in CB05. G. Sarwar (07/07) -C <> Hazardous Air Pollutants that are believed to undergo significant dry -C deposition. Hydrazine and triethylamine reactivities are based on analogies -C to NH3. Maleic anhydride reactivity is assumed similar to aldehydes. -C Toluene diisocyanate and hexamethylene diisocyanate reactivities are -C assumed to be similar to SO2. Diffusivities are calculated with standard -C formulas. W. Hutzell (04/08) -C %% G. Sarwar: added data for iodine and bromine species (03/2016) -C %% B. Hutzell: added dry deposition data for methane, acrylic acid, methyl chloride, -C and acetonitrile (09/2016) -C------------------------------------------------------------------------------- - - Use GRID_CONF ! horizontal & vertical domain specifications - Use LSM_MOD ! Land surface data - Use DEPVVARS, Only: ltotg - - Implicit None - - Include SUBST_CONST ! constants - - Type :: MET_Type -!> 2-D meteorological fields: - Real, Allocatable :: RDEPVHT ( :,: ) ! air dens / dep vel ht - Real, Allocatable :: DENS1 ( :,: ) ! layer 1 air density - Real, Allocatable :: PRSFC ( :,: ) ! surface pressure [Pa] - Real, Allocatable :: Q2 ( :,: ) ! 2 meter water vapor mixing ratio [kg/kg] - Real, Allocatable :: QSS_GRND ( :,: ) ! ground saturation water vapor mixing ratio [kg/kg] - Real, Allocatable :: RH ( :,: ) ! relative humidity [ratio] - Real, Allocatable :: RA ( :,: ) ! aerodynamic resistnace [s/m] - Real, Allocatable :: RS ( :,: ) ! stomatal resistnace [s/m] - Real, Allocatable :: RC ( :,: ) ! convective precipitation [cm] - Real, Allocatable :: RN ( :,: ) ! non-convective precipitation [mc] - Real, Allocatable :: RGRND ( :,: ) ! Solar radiation at the ground [W/m**2] - Real, Allocatable :: HFX ( :,: ) ! Sensible heat flux [W/m**2] - Real, Allocatable :: LH ( :,: ) ! Latent heat flux [W/m**2] - Real, Allocatable :: SNOCOV ( :,: ) ! Snow cover [1=yes, 0=no] - Real, Allocatable :: TEMP2 ( :,: ) ! two meter temperature [K] - Real, Allocatable :: TEMPG ( :,: ) ! skin temperature [K] - Real, Allocatable :: TSEASFC ( :,: ) ! SST [K] - Real, Allocatable :: USTAR ( :,: ) ! surface friction velocity [m/s] - Real, Allocatable :: VEG ( :,: ) ! fractional vegetation coverage [ratio] - Real, Allocatable :: LAI ( :,: ) ! grid cell leaf area index [m**2/m**2] - Real, Allocatable :: WR ( :,: ) ! precip intercepted by canopy [m] - Real, Allocatable :: WSPD10 ( :,: ) ! 10-m wind speed [m/s] - Real, Allocatable :: WSTAR ( :,: ) ! convective velocity scale [m/s] - Real, Allocatable :: Z0 ( :,: ) ! roughness length [m] - Real, Allocatable :: SOIM1 ( :,: ) ! 1 cm soil moisture [m**3/m**3] - Real, Allocatable :: SOIM2 ( :,: ) ! 1 m soil moisture [m**3/m**3] - Real, Allocatable :: SOIT1 ( :,: ) ! 1 cm soil temperature [K] - Real, Allocatable :: SOIT2 ( :,: ) ! 1 m soil temperature [K] - Real, Allocatable :: SEAICE ( :,: ) ! Sea ice coverage [%] - Real, Allocatable :: MOL ( :,: ) ! Monin-Obukhov length [m] - Real, Allocatable :: MOLI ( :,: ) ! inverse of Monin-Obukhov length [m] - Real, Allocatable :: HOL ( :,: ) ! PBL over Obukhov length - Real, Allocatable :: XPBL ( :,: ) ! PBL sigma height - Integer, Allocatable :: LPBL ( :,: ) ! PBL layer - Logical, Allocatable :: CONVCT ( :,: ) ! convection flag - Real, Allocatable :: PBL ( :,: ) ! pbl height (m) - Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) - -!> FENGSHA option - Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content - Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content - Real, Allocatable :: DRAG ( :,: ) ! Drag Partion - Real, Allocatable :: UTHR ( :,: ) ! Dry Threshold Friction Velocity - -!> U and V wind components on the cross grid points - Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] - Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] -!> 3-D meteorological fields: - Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s] - Real, Allocatable :: PRES ( :,:,: ) ! layer 1 pressure [Pa] - Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio - Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio - Real, Allocatable :: THETAV ( :,:,: ) ! potential temp - Real, Allocatable :: TA ( :,:,: ) ! temperature (K) - Real, Allocatable :: ZH ( :,:,: ) ! mid-layer height above ground [m] - Real, Allocatable :: ZF ( :,:,: ) ! layer height [m] - Real, Allocatable :: DZF ( :,:,: ) ! layer surface thickness - Real, Allocatable :: DENS ( :,:,: ) ! air density - Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian - Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian - Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian - End Type MET_Type - - Type :: GRID_Type -!> Grid infomation: -!> Vertical information - Real, Allocatable :: DX3F ( : ) ! sigma layer surface thickness ! vdiffacmx.F - Real, Allocatable :: RDX3F ( : ) ! reciprocal sigma layer thickness ! EMIS_DEFN.F, sedi.F, vdiffacmx.F, vdiffproc.F - Real, Allocatable :: RDX3M ( : ) ! reciprocal sigma midlayer thickness ! vdiffproc.F -!> Horizontal Information: - Real, Allocatable :: RMSFX4 ( :,: ) ! inverse map scale factor ** 4 - Real, Allocatable :: LON ( :,: ) ! longitude - Real, Allocatable :: LAT ( :,: ) ! latitude - Real, Allocatable :: LWMASK ( :,: ) ! land water mask - Real, Allocatable :: OCEAN ( :,: ) ! Open ocean - Real, Allocatable :: SZONE ( :,: ) ! Surf zone - Real, Allocatable :: PURB ( :,: ) ! percent urban [%] - Integer, Allocatable :: SLTYP ( :,: ) ! soil type [category] - Real, Allocatable :: WSAT ( :,: ) ! soil wilting point - Real, Allocatable :: WWLT ( :,: ) ! soil wilting point - Real, Allocatable :: BSLP ( :,: ) ! B Slope - Real, Allocatable :: WRES ( :,: ) ! Soil residual moisture point - Real, Allocatable :: WFC ( :,: ) ! soil field capacity -! Real, Allocatable :: RHOB ( :,: ) ! soil bulk density - Real, Allocatable :: LUFRAC ( :,:,: ) ! land use fraction (col,row,lu_type)[ratio] -C Land use information: - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. - End Type GRID_Type - - Type :: MOSAIC_Type ! (col,row,lu) - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. -!> Sub grid cell meteorological variables: - Real, Allocatable :: USTAR ( :,:,: ) ! surface friction velocity [m/s] - Real, Allocatable :: LAI ( :,:,: ) ! leaf area index [m**2/m**2] - Real, Allocatable :: VEG ( :,:,: ) ! vegetation fraction [ratio] - Real, Allocatable :: Z0 ( :,:,: ) ! vegetation fraction [ratio] - Real, Allocatable :: DELTA ( :,:,: ) ! Surface wetness [ratio] -!> Sub grid cell resistances - Real, Allocatable :: RA ( :,:,: ) ! aerodynamic resistance [s/m] - Real, Allocatable :: RSTW ( :,:,: ) ! Stomatal Resistance of water [s/m] - Real, Allocatable :: RINC ( :,:,: ) ! In-canopy resistance [s/m] - End Type MOSAIC_Type - - Type :: ChemMos_Type ! (col,row,lu,spc) - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: Lu_Type ( : ) ! general land use type e.g. water, forest, etc. - Character( 16 ), Allocatable :: SubName ( : ) ! Deposition species name -!> Sub grid cell chemically dependent resistances - Real, Allocatable :: Rb ( :,:,:,: ) ! quasi-laminar boundary layer resistance [s/m] - Real, Allocatable :: Rst ( :,:,:,: ) ! stomatal resistance [s/m] - Real, Allocatable :: Rgc ( :,:,:,: ) ! Canopy covered soil resistance [s/m] - Real, Allocatable :: Rgb ( :,:,:,: ) ! Barron soil resistance [s/m] - Real, Allocatable :: Rcut ( :,:,:,: ) ! soil resistance [s/m] - Real, Allocatable :: Rwat ( :,:,:,: ) ! surface water resistance [s/m] -!> Sub grid cell compensation point - Real, Allocatable :: Catm ( :,:,:,: ) ! Atmospheric [ppm] - Real, Allocatable :: CZ0 ( :,:,:,: ) ! compensation point at Z0 [ppm] - Real, Allocatable :: Cleaf( :,:,:,: ) ! Leaf compensation point [ppm] - Real, Allocatable :: Cstom( :,:,:,: ) ! Stomatal compensation point [ppm] - Real, Allocatable :: Ccut ( :,:,:,: ) ! Cuticular compensation point [ppm] - Real, Allocatable :: Csoil( :,:,:,: ) ! Soil compensation point [ppm] - End Type ChemMos_Type - - Type( MET_Type ), Save :: Met_Data - Type( GRID_Type ), Save :: Grid_Data - Type( MOSAIC_Type ), Save :: Mosaic_Data - Type( ChemMos_Type ), Save :: ChemMos_Data - - Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module -!> M3 asx constants - Real, Parameter :: a0 = 8.0 ! [dim'less] - Real, Parameter :: d3 = 1.38564e-2 ! [dim'less] - Real, Parameter :: dwat = 0.2178 ! [cm^2/s] at 273.15K - Real, Parameter :: hplus_ap = 1.0e-6 ! pH=6.0 leaf apoplast solution Ph (Massad et al 2008) - Real, Parameter :: hplus_def = 1.0e-5 ! pH=5.0 - Real, Parameter :: hplus_east = 1.0e-5 ! pH=5.0 - Real, Parameter :: hplus_h2o = 7.94328e-9 ! 10.0**(-8.1) - Real, Parameter :: hplus_west = 3.16228e-6 ! 10.0**(-5.5) - Real, Parameter :: kvis = 0.132 ! [cm^2 / s] at 273.15K - Real, Parameter :: pr = 0.709 ! [dim'less] - Real, Parameter :: rcut0 = 3000.0 ! [s/m] - Real, Parameter :: rcw0 = 125000.0 ! acc'd'g to Padro and - Real, Parameter :: resist_max = 1.0e30 ! maximum resistance - Real, Parameter :: rg0 = 1000.0 ! [s/m] - Real, Parameter :: rgwet0 = 25000.0 ! [s/m] - Real, Parameter :: rsndiff = 10.0 ! snow diffusivity fac - Real, Parameter :: rsnow0 = 1000.0 - Real, Parameter :: svp2 = 17.67 ! from MM5 and WRF - Real, Parameter :: svp3 = 29.65 ! from MM5 and WRF - Real, Parameter :: rt25inK = 1.0/(stdtemp + 25.0) ! 298.15K = 25C - Real, Parameter :: twothirds = 2.0 / 3.0 - Real, Parameter :: betah = 5.0 ! WRF 3.6 px uses Dyer - Real, Parameter :: gamah = 16.0 - Real, Parameter :: pr0 = 0.95 - Real, Parameter :: karman = 0.40 - Real, Parameter :: f3min = 0.25 - Real, Parameter :: ftmin = 0.0000001 ! m/s - Real, Parameter :: nscat = 16.0 - Real, Parameter :: rsmax = 5000.0 ! s/m - - Real :: ar ( ltotg ) ! reactivity relative to HNO3 - Real :: dif0 ( ltotg ) ! molecular diffusivity [cm2/s] - Real :: lebas ( ltotg ) ! Le Bas molar volume [cm3/mol ] - Real :: meso ( ltotg ) ! Exception for species that - ! react with cell walls. fo in - ! Wesely 1989 eq 6. - Character( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST - - Logical, Save :: MET_INITIALIZED = .false. - Real, Save :: CONVPA ! Pressure conversion factor file units to Pa - Logical, Save :: MINKZ - Logical, Save :: CSTAGUV ! Winds are available with C stagger? - Logical, Save :: ifwr = .false. - - Public :: INIT_MET - - Logical, Private, Save :: ifsst = .false. - Logical, Private, Save :: ifq2 = .false. - Logical, Private, Save :: rinv = .True. - Logical, Private, Save :: iflh = .false. - - Integer, Private :: C, R, L, S ! loop induction variables - Integer, Private :: SPC - Character( 16 ), Private, Save :: vname_rc, vname_rn, vname_uc, vname_vc - Real, Private, Save :: P0 ! reference pressure (100000.0 Pa) for Potential Temperature, note that in meteorology they do not use the SI 1 ATM. - - Integer, Private, Save :: LOGDEV - Integer, Private, Save :: GXOFF, GYOFF ! global origin offset from file - Integer, Private, Save :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ! MET_CRO_3D - Integer, Private, Save :: STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ! MET_DOT_3D - Integer, Private, Save :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ! MET_CRO_2D - Integer, Private, Save :: STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ! OCEAN_1 - - Real, Pointer, Private :: BUFF1D( : ) ! 1D temp var number of layers - Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var - Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var - -! FENGSHA option control - CHARACTER( 20 ), SAVE :: CTM_FENGSHA = 'CTM_FENGSHA '! env var for in-line - LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option - - INTEGER IOSX ! i/o and allocate memory status - - DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ - DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ - DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ - DATA subname( 4), dif0( 4), ar( 4), meso( 4), lebas( 4) / 'NO ', 0.1802, 2.0, 0.0, 14.0/ - DATA subname( 5), dif0( 5), ar( 5), meso( 5), lebas( 5) / 'O3 ', 0.1444, 12.0, 1.0, 21.0/ - DATA subname( 6), dif0( 6), ar( 6), meso( 6), lebas( 6) / 'HNO3 ', 0.1067, 8000.0, 0.0, 35.0/ - DATA subname( 7), dif0( 7), ar( 7), meso( 7), lebas( 7) / 'H2O2 ', 0.1300,34000.0, 1.0, 28.0/ !ar=34,000 such that r_cut=0.7 s/m as in Nguyen et al. 2015 - DATA subname( 8), dif0( 8), ar( 8), meso( 8), lebas( 8) / 'ACETALDEHYDE ', 0.1111, 10.0, 0.0, 56.0/ - DATA subname( 9), dif0( 9), ar( 9), meso( 9), lebas( 9) / 'FORMALDEHYDE ', 0.1554, 10.0, 0.0, 35.0/ - DATA subname( 10), dif0( 10), ar( 10), meso( 10), lebas( 10) / 'METHYLHYDROPEROX', 0.1179, 10.0, 0.3, 49.0/ !meso change from 0.1 to 0.3, Wolfe and Thornton 2011 ACP per J. Bash - DATA subname( 11), dif0( 11), ar( 11), meso( 11), lebas( 11) / 'PEROXYACETIC_ACI', 0.0868, 20.0, 0.1, 70.0/ - DATA subname( 12), dif0( 12), ar( 12), meso( 12), lebas( 12) / 'ACETIC_ACID ', 0.0944, 20.0, 0.0, 63.0/ - DATA subname( 13), dif0( 13), ar( 13), meso( 13), lebas( 13) / 'NH3 ', 0.1978, 20.0, 0.0, 28.0/ - DATA subname( 14), dif0( 14), ar( 14), meso( 14), lebas( 14) / 'PAN ', 0.0687, 16.0, 0.1, 91.0/ - DATA subname( 15), dif0( 15), ar( 15), meso( 15), lebas( 15) / 'HNO2 ', 0.1349, 20.0, 0.1, 28.0/ - DATA subname( 16), dif0( 16), ar( 16), meso( 16), lebas( 16) / 'CO ', 0.1807, 5.0, 0.0, 14.0/ - DATA subname( 17), dif0( 17), ar( 17), meso( 17), lebas( 17) / 'METHANOL ', 0.1329, 2.0, 0.0, 42.0/ - DATA subname( 18), dif0( 18), ar( 18), meso( 18), lebas( 18) / 'N2O5 ', 0.0808, 5000.0, 0.0, 49.0/ - DATA subname( 19), dif0( 19), ar( 19), meso( 19), lebas( 19) / 'NO3 ', 0.1153, 5000.0, 0.0, 28.0/ - DATA subname( 20), dif0( 20), ar( 20), meso( 20), lebas( 20) / 'GENERIC_ALDEHYDE', 0.0916, 10.0, 0.0, 56.0/ - DATA subname( 21), dif0( 21), ar( 21), meso( 21), lebas( 21) / 'CL2 ', 0.1080, 10.0, 0.0, 49.0/ - DATA subname( 22), dif0( 22), ar( 22), meso( 22), lebas( 22) / 'HOCL ', 0.1300, 10.0, 0.0, 38.5/ - DATA subname( 23), dif0( 23), ar( 23), meso( 23), lebas( 23) / 'HCL ', 0.1510, 8000.0, 0.0, 31.5/ - DATA subname( 24), dif0( 24), ar( 24), meso( 24), lebas( 24) / 'FMCL ', 0.1094, 10.0, 0.0, 45.5/ - DATA subname( 25), dif0( 25), ar( 25), meso( 25), lebas( 25) / 'HG ', 0.1194, 0.1, 0.0, 14.8/ ! lebas not used - DATA subname( 26), dif0( 26), ar( 26), meso( 26), lebas( 26) / 'HGIIGAS ', 0.0976, 8000.0, 0.0, 95.0/ ! estimation from back calculating to get dw25 = 1.04e-5 (Garland et al, 1965) - DATA subname( 27), dif0( 27), ar( 27), meso( 27), lebas( 27) / 'TECDD_2378 ', 0.0525, 2.0, 0.0, 217.0/ - DATA subname( 28), dif0( 28), ar( 28), meso( 28), lebas( 28) / 'PECDD_12378 ', 0.0508, 2.0, 0.0, 234.5/ - DATA subname( 29), dif0( 29), ar( 29), meso( 29), lebas( 29) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 30), dif0( 30), ar( 30), meso( 30), lebas( 30) / 'HXCDD_123678 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 31), dif0( 31), ar( 31), meso( 31), lebas( 31) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 32), dif0( 32), ar( 32), meso( 32), lebas( 32) / 'HPCDD_1234678 ', 0.0480, 2.0, 0.0, 269.5/ - DATA subname( 33), dif0( 33), ar( 33), meso( 33), lebas( 33) / 'OTCDD ', 0.0474, 2.0, 0.0, 287.0/ - DATA subname( 34), dif0( 34), ar( 34), meso( 34), lebas( 34) / 'TECDF_2378 ', 0.0534, 2.0, 0.0, 210.0/ - DATA subname( 35), dif0( 35), ar( 35), meso( 35), lebas( 35) / 'PECDF_12378 ', 0.0517, 2.0, 0.0, 227.5/ - DATA subname( 36), dif0( 36), ar( 36), meso( 36), lebas( 36) / 'PECDF_23478 ', 0.0517, 2.0, 0.0, 227.5/ - DATA subname( 37), dif0( 37), ar( 37), meso( 37), lebas( 37) / 'HXCDF_123478 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 38), dif0( 38), ar( 38), meso( 38), lebas( 38) / 'HXCDF_123678 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 39), dif0( 39), ar( 39), meso( 39), lebas( 39) / 'HXCDF_234678 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 40), dif0( 40), ar( 40), meso( 40), lebas( 40) / 'HXCDF_123789 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 41), dif0( 41), ar( 41), meso( 41), lebas( 41) / 'HPCDF_1234678 ', 0.0487, 2.0, 0.0, 262.5/ - DATA subname( 42), dif0( 42), ar( 42), meso( 42), lebas( 42) / 'HPCDF_1234789 ', 0.0487, 2.0, 0.0, 262.5/ - DATA subname( 43), dif0( 43), ar( 43), meso( 43), lebas( 43) / 'OTCDF ', 0.0474, 2.0, 0.0, 280.0/ - DATA subname( 44), dif0( 44), ar( 44), meso( 44), lebas( 44) / 'NAPHTHALENE ', 0.0778, 4.0, 0.0, 119.0/ - DATA subname( 45), dif0( 45), ar( 45), meso( 45), lebas( 45) / '1NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ - DATA subname( 46), dif0( 46), ar( 46), meso( 46), lebas( 46) / '2NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ - DATA subname( 47), dif0( 47), ar( 47), meso( 47), lebas( 47) / '14NAPHTHOQUINONE', 0.0780, 4.0, 0.0, 119.0/ - DATA subname( 48), dif0( 48), ar( 48), meso( 48), lebas( 48) / 'HEXAMETHYLE_DIIS', 0.0380, 10.0, 0.0, 196.0/ - DATA subname( 49), dif0( 49), ar( 49), meso( 49), lebas( 49) / 'HYDRAZINE ', 0.4164, 20.0, 0.0, 42.0/ - DATA subname( 50), dif0( 50), ar( 50), meso( 50), lebas( 50) / 'MALEIC_ANHYDRIDE', 0.0950, 10.0, 0.0, 70.0/ - DATA subname( 51), dif0( 51), ar( 51), meso( 51), lebas( 51) / '24-TOLUENE_DIIS ', 0.0610, 10.0, 0.0, 154.0/ - DATA subname( 52), dif0( 52), ar( 52), meso( 52), lebas( 52) / 'TRIETHYLAMINE ', 0.0881, 20.0, 0.0, 154.0/ - DATA subname( 53), dif0( 53), ar( 53), meso( 53), lebas( 53) / 'ORG_NTR ', 0.0607, 16.0, 0.0, 160.0/ ! assumes 58.2% C5H11O4N and 41.8% C5H11O3N - DATA subname( 54), dif0( 54), ar( 54), meso( 54), lebas( 54) / 'HYDROXY_NITRATES', 0.0609, 16.0, 0.0, 156.1/ - DATA subname( 55), dif0( 55), ar( 55), meso( 55), lebas( 55) / 'MPAN ', 0.0580, 16.0, 0.1, 133.0/ - DATA subname( 56), dif0( 56), ar( 56), meso( 56), lebas( 56) / 'PPN ', 0.0631, 16.0, 0.1, 118.2/ - DATA subname( 57), dif0( 57), ar( 57), meso( 57), lebas( 57) / 'MVK ', 0.0810, 8.0, 1.0, 88.8/ - DATA subname( 58), dif0( 58), ar( 58), meso( 58), lebas( 58) / 'DINTR ', 0.0617, 16.0, 0.1, 169.8/ - DATA subname( 59), dif0( 59), ar( 59), meso( 59), lebas( 59) / 'NTR_ALK ', 0.0688, 16.0, 0.1, 133.0/ - DATA subname( 60), dif0( 60), ar( 60), meso( 60), lebas( 60) / 'NTR_OH ', 0.0665, 16.0, 0.1, 140.4/ - DATA subname( 61), dif0( 61), ar( 61), meso( 61), lebas( 61) / 'HYDROXY_NITRATES', 0.0646, 16.0, 0.0, 147.8/ - DATA subname( 62), dif0( 62), ar( 62), meso( 62), lebas( 62) / 'PROPNN ', 0.0677, 16.0, 0.0, 133.0/ - DATA subname( 63), dif0( 63), ar( 63), meso( 63), lebas( 63) / 'NITRYL_CHLORIDE ', 0.0888, 8.0, 0.0, 45.5/ ! dif0 estimated following Erickson III et al., JGR, 104, D7, 8347-8372, 1999 - DATA subname( 64), dif0( 64), ar( 64), meso( 64), lebas( 64) / 'ISOPNN ',0.0457, 8.0, 0.0, 206.8/ - DATA subname( 65), dif0( 65), ar( 65), meso( 65), lebas( 65) / 'MTNO3 ',0.0453, 8.0, 0.0, 251.2/ - DATA subname( 66), dif0( 66), ar( 66), meso( 66), lebas( 66) / 'IEPOX ',0.0579, 8.0, 0.0, 110.8/ - DATA subname( 67), dif0( 67), ar( 67), meso( 67), lebas( 67) / 'HACET ',0.1060, 8.0, 0.0, 72.6/ ! dif0 from Nguyen 2015 PNAS - DATA subname( 68), dif0( 68), ar( 68), meso( 68), lebas( 68) / 'SVALK1 ',0.0514, 20.0, 0.0, 280.5/ - DATA subname( 69), dif0( 69), ar( 69), meso( 69), lebas( 69) / 'SVALK2 ',0.0546, 20.0, 0.0, 275.6/ - DATA subname( 70), dif0( 70), ar( 70), meso( 70), lebas( 70) / 'SVBNZ1 ',0.0642, 20.0, 0.0, 134.1/ - DATA subname( 71), dif0( 71), ar( 71), meso( 71), lebas( 71) / 'SVBNZ2 ',0.0726, 20.0, 0.0, 127.5/ - DATA subname( 72), dif0( 72), ar( 72), meso( 72), lebas( 72) / 'SVISO1 ',0.0733, 20.0, 0.0, 126.3/ - DATA subname( 73), dif0( 73), ar( 73), meso( 73), lebas( 73) / 'SVISO2 ',0.0729, 20.0, 0.0, 123.8/ - DATA subname( 74), dif0( 74), ar( 74), meso( 74), lebas( 74) / 'SVPAH1 ',0.0564, 20.0, 0.0, 235.7/ - DATA subname( 75), dif0( 75), ar( 75), meso( 75), lebas( 75) / 'SVPAH2 ',0.0599, 20.0, 0.0, 231.5/ - DATA subname( 76), dif0( 76), ar( 76), meso( 76), lebas( 76) / 'SVSQT ',0.0451, 20.0, 0.0, 346.5/ - DATA subname( 77), dif0( 77), ar( 77), meso( 77), lebas( 77) / 'SVTOL1 ',0.0637, 20.0, 0.0, 153.7/ - DATA subname( 78), dif0( 78), ar( 78), meso( 78), lebas( 78) / 'SVTOL2 ',0.0607, 20.0, 0.0, 194.1/ - DATA subname( 79), dif0( 79), ar( 79), meso( 79), lebas( 79) / 'SVTRP1 ',0.0603, 20.0, 0.0, 194.9/ - DATA subname( 80), dif0( 80), ar( 80), meso( 80), lebas( 80) / 'SVTRP2 ',0.0559, 20.0, 0.0, 218.8/ - DATA subname( 81), dif0( 81), ar( 81), meso( 81), lebas( 81) / 'SVXYL1 ',0.0610, 20.0, 0.0, 154.6/ - DATA subname( 82), dif0( 82), ar( 82), meso( 82), lebas( 82) / 'SVXYL2 ',0.0585, 20.0, 0.0, 194.6/ - DATA subname( 83), dif0( 83), ar( 83), meso( 83), lebas( 83) / 'IO ',0.1002, 8.0, 0.0, 44.4/ - DATA subname( 84), dif0( 84), ar( 84), meso( 84), lebas( 84) / 'OIO ',0.0938, 8.0, 0.0, 51.8/ - DATA subname( 85), dif0( 85), ar( 85), meso( 85), lebas( 85) / 'I2O2 ',0.0732, 8.0, 0.0, 88.8/ - DATA subname( 86), dif0( 86), ar( 86), meso( 86), lebas( 86) / 'I2O3 ',0.0707, 8.0, 0.0, 96.2/ - DATA subname( 87), dif0( 87), ar( 87), meso( 87), lebas( 87) / 'I2O4 ',0.0684, 8.0, 0.0, 103.6/ - DATA subname( 88), dif0( 88), ar( 88), meso( 88), lebas( 88) / 'HI ',0.1045, 8.0, 0.0, 40.7/ - DATA subname( 89), dif0( 89), ar( 89), meso( 89), lebas( 89) / 'HOI ',0.0972, 8.0, 0.0, 48.1/ - DATA subname( 90), dif0( 90), ar( 90), meso( 90), lebas( 90) / 'INO ',0.0882, 8.0, 0.0, 60.9/ - DATA subname( 91), dif0( 91), ar( 91), meso( 91), lebas( 91) / 'INO2 ',0.0883, 20.0, 0.0, 69.2/ - DATA subname( 92), dif0( 92), ar( 92), meso( 92), lebas( 92) / 'IONO2 ',0.0792, 8.0, 0.0, 77.5/ - DATA subname( 93), dif0( 93), ar( 93), meso( 93), lebas( 93) / 'BRO ',0.1144, 1.0, 0.0, 34.4/ - DATA subname( 94), dif0( 94), ar( 94), meso( 94), lebas( 94) / 'HOBR ',0.1101, 1.0, 0.0, 38.1/ - DATA subname( 95), dif0( 95), ar( 95), meso( 95), lebas( 95) / 'HBR ',0.1216, 2.0, 0.0, 30.7/ - DATA subname( 96), dif0( 96), ar( 96), meso( 96), lebas( 96) / 'BRONO2 ',0.0855, 1.0, 0.0, 67.5/ - DATA subname( 97), dif0( 97), ar( 97), meso( 97), lebas( 97) / 'BRNO2 ',0.0909, 1.0, 0.0, 59.2/ - DATA subname( 98), dif0( 98), ar( 98), meso( 98), lebas( 98) / 'BRCL ',0.0966, 1.0, 0.0, 51.6/ - DATA subname( 99), dif0( 99), ar( 99), meso( 99), lebas( 99) / 'DMS ',0.0926, 2.0, 0.0, 77.4/ - DATA subname(100), dif0(100), ar(100), meso(100), lebas(100) / 'MSA ',0.0896, 2.0, 0.0, 77.4/ - DATA subname(101), dif0(101), ar(101), meso(101), lebas(101) / 'METHANE ',0.2107, 2.0, 0.0, 29.6/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. - DATA subname(102), dif0(102), ar(102), meso(102), lebas(102) / 'ACRYACID ',0.0908, 2.0, 0.0, 63.2/ - DATA subname(103), dif0(103), ar(103), meso(103), lebas(103) / 'CARBSULFIDE ',0.1240, 5.0, 0.0, 51.5/ - DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ - DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. - - CONTAINS - -C======================================================================= - Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) - -C----------------------------------------------------------------------- -C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; -C allocatable RDEPVHT, RJACM, RRHOJ -C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and -C mid-layer -C Tanya took JACOBF out of METCRO3D! Improvise -C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical -C domain specifications in one module -C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN -C----------------------------------------------------------------------- - - Use UTILIO_DEFN - - Implicit None - - Include SUBST_FILES_ID ! file name parameters - Include SUBST_CONST ! constants - -C Arguments: - Integer, Intent( IN ) :: JDATE, JTIME ! internal simulation date&time - Logical, Intent( IN ) :: MOSAIC - Logical, Intent( IN ) :: ABFLUX - Logical, Intent( IN ) :: HGBIDI - -C File variables: - Real, Pointer :: MSFX2 ( :,: ) - Real, Pointer :: SOILCAT ( :,: ) - Real, Pointer :: X3M ( : ) - -C Local variables: - Character( 16 ) :: PNAME = 'INIT_MET' - Character( 16 ) :: VNAME - CHARACTER( 16 ) :: UNITSCK - CHARACTER( 30 ) :: MSG1 = ' Error interpolating variable ' - Character( 96 ) :: XMSG = ' ' - -C for INTERPX - Integer STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 - Integer V - Integer ALLOCSTAT - -C----------------------------------------------------------------------- - - LOGDEV = INIT3() - - If( MET_INITIALIZED )Return - -!> Allocate buffers - ALLOCATE ( BUFF1D( NLAYS ), - & BUFF2D( NCOLS,NROWS ), - & BUFF3D( NCOLS,NROWS,NLAYS ), STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating Buffers' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - BUFF1D = 0.0 - BUFF2D = 0.0 - BUFF3D = 0.0 - -!> Allocate shared arrays -!> Met_Data - ALLOCATE( Met_Data%RDEPVHT ( NCOLS,NROWS ), - & Met_Data%DENS1 ( NCOLS,NROWS ), - & Met_Data%PRSFC ( NCOLS,NROWS ), - & Met_Data%Q2 ( NCOLS,NROWS ), - & Met_Data%QSS_GRND ( NCOLS,NROWS ), - & Met_Data%RH ( NCOLS,NROWS ), - & Met_Data%RA ( NCOLS,NROWS ), - & Met_Data%RS ( NCOLS,NROWS ), - & Met_Data%RC ( NCOLS,NROWS ), - & Met_Data%RN ( NCOLS,NROWS ), - & Met_Data%RGRND ( NCOLS,NROWS ), - & Met_Data%HFX ( NCOLS,NROWS ), - & Met_Data%LH ( NCOLS,NROWS ), - & Met_Data%SNOCOV ( NCOLS,NROWS ), - & Met_Data%TEMP2 ( NCOLS,NROWS ), - & Met_Data%TEMPG ( NCOLS,NROWS ), - & Met_Data%TSEASFC ( NCOLS,NROWS ), - & Met_Data%USTAR ( NCOLS,NROWS ), - & Met_Data%VEG ( NCOLS,NROWS ), - & Met_Data%LAI ( NCOLS,NROWS ), - & Met_Data%WR ( NCOLS,NROWS ), - & Met_Data%WSPD10 ( NCOLS,NROWS ), - & Met_Data%WSTAR ( NCOLS,NROWS ), - & Met_Data%Z0 ( NCOLS,NROWS ), - & Met_Data%SOIM1 ( NCOLS,NROWS ), - & Met_Data%SOIT1 ( NCOLS,NROWS ), - & Met_Data%SEAICE ( NCOLS,NROWS ), - & Met_Data%MOL ( NCOLS,NROWS ), - & Met_Data%MOLI ( NCOLS,NROWS ), - & Met_Data%HOL ( NCOLS,NROWS ), - & Met_Data%XPBL ( NCOLS,NROWS ), - & Met_Data%LPBL ( NCOLS,NROWS ), - & Met_Data%CONVCT ( NCOLS,NROWS ), - & Met_Data%PBL ( NCOLS,NROWS ), - & Met_Data%NACL_EMIS( NCOLS,NROWS ), - & Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ), - & Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ), - & Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ), - & Met_Data%PRES ( NCOLS,NROWS,NLAYS ), - & Met_Data%QV ( NCOLS,NROWS,NLAYS ), - & Met_Data%QC ( NCOLS,NROWS,NLAYS ), - & Met_Data%THETAV ( NCOLS,NROWS,NLAYS ), - & Met_Data%TA ( NCOLS,NROWS,NLAYS ), - & Met_Data%ZH ( NCOLS,NROWS,NLAYS ), - & Met_Data%ZF ( NCOLS,NROWS,NLAYS ), - & Met_Data%DZF ( NCOLS,NROWS,NLAYS ), - & Met_Data%DENS ( NCOLS,NROWS,NLAYS ), - & Met_Data%RJACM ( NCOLS,NROWS,NLAYS ), - & Met_Data%RJACF ( NCOLS,NROWS,NLAYS ), - & Met_Data%RRHOJ ( NCOLS,NROWS,NLAYS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating met vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - ALLOCATE( Grid_Data%DX3F ( NLAYS ), - & Grid_Data%RDX3F ( NLAYS ), - & Grid_Data%RDX3M ( NLAYS ), - & Grid_Data%RMSFX4 ( NCOLS,NROWS ), - & Grid_Data%LON ( NCOLS,NROWS ), - & Grid_Data%LAT ( NCOLS,NROWS ), - & Grid_Data%LWMASK ( NCOLS,NROWS ), - & Grid_Data%OCEAN ( NCOLS,NROWS ), - & Grid_Data%SZONE ( NCOLS,NROWS ), - & Grid_Data%PURB ( NCOLS,NROWS ), - & Grid_Data%SLTYP ( NCOLS,NROWS ), - & Grid_Data%NAME ( n_lufrac ), - & Grid_Data%LU_Type ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating grid vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Grid_Data%NAME = name_lu - Grid_Data%LU_Type = cat_lu - - If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then - ALLOCATE( Met_Data%SOIM2 ( NCOLS,NROWS ), - & Met_Data%SOIT2 ( NCOLS,NROWS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic met vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - ALLOCATE( Grid_Data%WSAT ( NCOLS,NROWS ), - & Grid_Data%WWLT ( NCOLS,NROWS ), - & Grid_Data%BSLP ( NCOLS,NROWS ), - & Grid_Data%WRES ( NCOLS,NROWS ), - & Grid_Data%WFC ( NCOLS,NROWS ), - & Grid_Data%LUFRAC ( NCOLS,NROWS,n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic grid vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Grid_Data%WSAT = 0.0 - Grid_Data%WWLT = 0.0 - Grid_Data%WFC = 0.0 - Grid_Data%WRES = 0.0 - Grid_Data%BSLP = 0.0 - - ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%VEG ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%Z0 ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RA ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RSTW ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RINC ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%NAME ( n_lufrac ), - & Mosaic_Data%LU_Type ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Mosaic_Data%USTAR = 0.0 - Mosaic_Data%LAI = 0.0 - Mosaic_Data%DELTA = 0.0 - Mosaic_Data%VEG = 0.0 - Mosaic_Data%Z0 = 0.000001 - Mosaic_Data%RSTW = 0.0 - Mosaic_Data%RINC = 0.0 - Mosaic_Data%NAME = name_lu - Mosaic_Data%LU_Type = cat_lu - - ALLOCATE( ChemMos_Data%Rb ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rst ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rcut ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rgc ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rgb ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rwat ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%CZ0 ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Cleaf ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Cstom ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Ccut ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Csoil ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%NAME ( n_lufrac ), - & ChemMos_Data%LU_Type ( n_lufrac ), - & ChemMos_Data%Subname ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating chemistry dependent mosaic vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - ChemMos_Data%Rb = resist_max - ChemMos_Data%Rst = resist_max - ChemMos_Data%Rcut = resist_max - ChemMos_Data%Rgc = resist_max - ChemMos_Data%Rgb = resist_max - ChemMos_Data%Rwat = resist_max - ChemMos_Data%CZ0 = 0.0 - ChemMos_Data%Cleaf = 0.0 - ChemMos_Data%Cstom = 0.0 - ChemMos_Data%Ccut = 0.0 - ChemMos_Data%Csoil = 0.0 - ChemMos_Data%NAME = name_lu - ChemMos_Data%LU_Type = cat_lu - ChemMos_Data%SubName = subname - End If - -!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc - FENGSHA = ENVYN( 'CTM_FENGSHA', - & 'Flag for in-line fengsha ', - & .FALSE., IOSX ) - - If ( FENGSHA ) Then - ALLOCATE( Met_Data%CLAYF ( NCOLS,NROWS ), - & Met_Data%SANDF ( NCOLS,NROWS ), - & Met_Data%DRAG ( NCOLS,NROWS ), - & Met_Data%UTHR ( NCOLS,NROWS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating Fengsha variables' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - -!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc - - If ( .Not. desc3( met_cro_2d ) ) Then - xmsg = 'Could not get ' // MET_CRO_2D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) rinv = .FALSE. ! Ra and Rst are in units s/m - - SPC = INDEX1( 'WR', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifwr = .True. ! canopy wetness is in METCRO2D - - SPC = INDEX1( 'Q2', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifq2 = .True. ! two meter mixing ratio in METCRO2D - - SPC = INDEX1( 'TSEASFC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifsst = .True. ! two meter SST in METCRO2D - - SPC = INDEX1( 'LH', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) iflh = .True. ! LH in METCRO2D - - SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_rc = 'RCA' - Else - vname_rc = 'RC' - End If - - SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_rn = 'RNA' - Else - vname_rn = 'RN' - End If - - If ( .Not. desc3( met_dot_3d ) ) Then - xmsg = 'Could not get ' // MET_DOT_3D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - SPC = INDEX1( 'UWINDC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_uc = 'UWINDC' - CSTAGUV = .TRUE. - Else - vname_uc = 'UWIND' - CSTAGUV = .FALSE. - End If - - SPC = INDEX1( 'VWINDC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_vc = 'VWINDC' - Else - vname_vc = 'VWIND' - End If - - If ( .Not. desc3( met_cro_3d ) ) Then - xmsg = 'Could not get ' // MET_CRO_3D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - V = INDEX1( 'PRES', NVARS3D, VNAME3D ) - If ( V .Ne. 0 ) Then - UNITSCK = UNITS3D( V ) - Else - XMSG = 'Could not get variable PRES from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Select Case (UNITSCK) - Case ( 'PASCAL','pascal','Pascal','PA','pa','Pa' ) - CONVPA = 1.0 - P0 = 100000.0 - Case ( 'MILLIBAR','millibar','Millibar','MB','mb','Mb' ) - CONVPA = 1.0E-02 - P0 = 100000.0 * CONVPA - Case ( 'CENTIBAR','centibar','Centibar','CB','cb','Cb' ) - CONVPA = 1.0E-03 - P0 = 100000.0 * CONVPA - Case Default - XMSG = 'Units incorrect on ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End Select - - MINKZ = .True. ! default - MINKZ = ENVYN( 'KZMIN', 'Kz min on flag', MINKZ, ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Write( LOGDEV,'(5X, A)' ) 'Kz min on flag' - Select Case( ALLOCSTAT ) - Case ( 1 ) - XMSG = 'Environment variable improperly formatted' - Call M3WARN( PNAME, JDATE, JTIME, XMSG ) - Case ( -1 ) - XMSG = 'Environment variable set, but empty ... Using default:' - Write( LOGDEV,'(5X, A)' ) XMSG - Case ( -2 ) - XMSG = 'Environment variable not set ... Using default:' - Write( LOGDEV,'(5X, A)' ) XMSG - End Select - - If ( .Not. MINKZ ) Then - XMSG = 'This run uses Kz0UT, *NOT* KZMIN in subroutine edyintb.' - Write( LOGDEV,'(/5X, A, /)' ) XMSG - End If - -!> Open the met files - - Call SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, - & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) - Call SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, - & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) - Call SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, - & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) - Call SUBHFILE ( MET_DOT_3D, GXOFF, GYOFF, - & STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ) - CALL SUBHFILE ( OCEAN_1, GXOFF, GYOFF, - & STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ) -!> Get sigma coordinate variables - X3M => BUFF1D - Do L = 1, NLAYS - Grid_Data%DX3F( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) - Grid_Data%RDX3F( L ) = 1.0 / Grid_Data%DX3F( L ) - X3M( L ) = 0.5 * ( X3FACE_GD( L ) + X3FACE_GD( L-1 ) ) - End Do - Do L = 1, NLAYS - 1 - Grid_Data%RDX3M( L ) = 1.0 / ( X3M( L+1 ) - X3M( L ) ) - End Do - Grid_Data%RDX3M( NLAYS ) = 0.0 -!> nullify pointer - Nullify( X3M ) - -!> reciprical of msfx2**2 -!> assign MSFX2 - MSFX2 => BUFF2D - VNAME = 'MSFX2' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, MSFX2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Grid_Data%RMSFX4 = 1.0 / ( MSFX2**2 ) -!> nullify pointer - Nullify( MSFX2 ) - - VNAME = 'LON' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LON ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'LAT' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LAT ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'LWMASK' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LWMASK ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'PURB' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%PURB ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - SOILCAT => BUFF2D - VNAME = 'SLTYP' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, SOILCAT ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Grid_Data%SLTYP = NINT( SOILCAT ) - Nullify( SOILCAT ) - - If ( ABFLUX .Or. MOSAIC ) Then - Do l = 1, n_lufrac - Write( vname,'( "LUFRAC_",I2.2 )' ) l - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LUFRAC( :,:,l ) ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End Do - - Forall( C = 1:MY_NCOLS, R = 1:MY_NROWS, Grid_Data%SLTYP(C,R) .Le. 11 ) - Grid_Data%WSAT( C,R ) = WSAT( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WWLT( C,R ) = WWLT( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WFC ( C,R ) = WFC ( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WRES( C,R ) = WRES( Grid_Data%SLTYP( C,R ) ) - Grid_Data%BSLP( C,R ) = BSLP( Grid_Data%SLTYP( C,R ) ) - End Forall - End If - -!> Read fractional seawater and surf-zone coverage from the OCEAN file. -!> Store results in the OCEAN and SZONE arrays. - IF ( .NOT. OPEN3( OCEAN_1, FSREAD3, PNAME ) ) THEN - XMSG = 'Open failure for ' // OCEAN_1 - CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'OPEN' - If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, - & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, - & 1,1,JDATE, JTIME, Grid_Data%OCEAN ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SURF' - If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, - & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, - & 1,1,JDATE, JTIME, Grid_Data%SZONE ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - MET_INITIALIZED = .true. - - Return - End Subroutine INIT_MET - -C======================================================================= - Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) - -C----------------------------------------------------------------------- -C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; -C allocatable RDEPVHT, RJACM, RRHOJ -C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and -C mid-layer -C Tanya took JACOBF out of METCRO3D! Improvise -C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical -C domain specifications in one module -C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN -C----------------------------------------------------------------------- - - USE GRID_CONF ! horizontal & vertical domain specifications - Use UTILIO_DEFN -#ifdef parallel - USE SE_MODULES ! stenex (using SE_COMM_MODULE) -#else - USE NOOP_MODULES ! stenex (using NOOP_COMM_MODULE) -#endif - - Implicit None - - Include SUBST_FILES_ID ! file name parameters - Include SUBST_PE_COMM ! PE communication displacement and direction - Include SUBST_CONST ! constants - -C Arguments: - - Integer, Intent( IN ) :: JDATE, JTIME, TSTEP ! internal simulation date&time - Logical, Intent( IN ) :: MOSAIC - Logical, Intent( IN ) :: ABFLUX - Logical, Intent( IN ) :: HGBIDI - -C Parameters: - Real, Parameter :: cond_min = 1.0 / resist_max ! minimum conductance [m/s] - Real, Parameter :: KZMAXL = 500.0 ! upper limit for min Kz [m] - Real, Parameter :: KZ0UT = 1.0 ! minimum eddy diffusivity [m**2/sec] KZ0 - Real, Parameter :: KZL = 0.01 ! lowest KZ - Real, Parameter :: KZU = 1.0 ! 2.0 ! highest KZ - Real, Parameter :: EPS = 1.0E-08 ! small number for temperature difference - -C Local variables: - Real FINT - Real CPAIR, LV, QST - Real TMPFX, TMPVTCON, TST, TSTV - Real, Pointer :: Es_Grnd ( :,: ) - Real, Pointer :: Es_Air ( :,: ) - Real, Pointer :: TV ( :,:,: ) - Integer LP - Integer C, R, L ! loop induction variables - - Character( 16 ) :: PNAME = 'GET_MET' - Character( 16 ) :: VNAME - CharactER( 30 ) :: MSG1 = ' Error interpolating variable ' - Character( 96 ) :: XMSG = ' ' - -C----------------------------------------------------------------------- -C Interpolate file input variables and format for output -C-------------------------------- MET_CRO_3D -------------------------------- - - VNAME = 'ZH' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%ZH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'PRES' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%PRES ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'ZF' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%ZF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'DENS' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%DENS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - - Met_Data%DENS1 = Met_Data%DENS( :,:,1 ) - - VNAME = 'JACOBM' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RJACM ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RJACM = 1.0 / Met_Data%RJACM - - VNAME = 'JACOBF' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RJACF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RJACF = 1.0 / Met_Data%RJACF - - VNAME = 'DENSA_J' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RRHOJ ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RRHOJ = 1.0 / Met_Data%RRHOJ - - VNAME = 'TA' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%TA ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'QV' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%QV ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'QC' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%QC ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - -C-------------------------------- MET_CRO_2D -------------------------------- -C Vegetation and surface vars - VNAME = 'LAI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LAI ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'VEG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%VEG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'ZRUF' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%Z0 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If -C FENGSHA - If ( FENGSHA ) Then - write(*,*) 'Read clayfrac' - VNAME = 'CLAYF' - write(*,*) VNAME, PNAME - write(*,*) JDATE, JTIME - write(*,*) STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2 - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%CLAYF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - write(*,*) 'read sandfrac' - VNAME = 'SANDF' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%SANDF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - write(*,*) 'read drag' - VNAME = 'DRAG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%DRAG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - write(*,*) 'Read uthr' - VNAME = 'UTHR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%UTHR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If -C Soil vars - VNAME = 'SOIM1' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIM1 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then - VNAME = 'SOIM2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIM2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SOIT2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIT2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - VNAME = 'SOIT1' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIT1 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SEAICE' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SEAICE ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - -C met vars - - VNAME = 'PRSFC' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%PRSFC ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'RGRND' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RGRND ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SNOCOV' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SNOCOV ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Where( Met_Data%SNOCOV .Lt. 0.0 ) - Met_Data%SNOCOV = 0.0 - End Where - - VNAME = 'TEMP2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TEMP2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'TEMPG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TEMPG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'USTAR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%USTAR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'WSPD10' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%WSPD10 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'HFX' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%HFX ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( iflh ) Then - VNAME = 'LH' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else ! for backward compatibility - VNAME = 'QFX' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - VNAME = 'PBL' - IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%PBL ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - -C Met_cro_2D variables that have recently changed due to MCIP or WRF/CMAQ - - If ( .Not. INTERPX( MET_CRO_2D, vname_rn, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RN ) ) Then - XMSG = MSG1 // TRIM( vname_rn ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( .Not. INTERPX( MET_CRO_2D, vname_rc, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RC ) ) Then - XMSG = MSG1 // TRIM( vname_rc ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( ifwr ) Then - VNAME = 'WR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%WR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - If ( ifsst ) Then - VNAME = 'TSEASFC' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TSEASFC ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else - Met_Data%TSEASFC = Met_Data%TEMPG - End If - - If ( rinv ) Then - VNAME = 'RADYNI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RA ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Where( Met_Data%RA .Gt. cond_min ) - Met_Data%RA = 1.0/Met_Data%RA - Elsewhere - Met_Data%RA = resist_max - End Where - - VNAME = 'RSTOMI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Where( Met_Data%RS .Gt. cond_min ) - Met_Data%RS = 1.0 / Met_Data%RS - Elsewhere - Met_Data%RS = resist_max - End Where - - Else - - VNAME = 'RA' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RA ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'RS' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - End If - - If ( ifq2 ) Then ! Q2 in METCRO2D - VNAME = 'Q2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%Q2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else - Met_Data%Q2 = Met_Data%QV( :,:,1 ) - End If - - Es_Grnd => BUFF2D - Where( Met_Data%TEMPG .Lt. stdtemp ) - Es_Grnd = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMPG ) ) - Elsewhere - Es_Grnd = vp0 *Exp( svp2 * ( Met_Data%TEMPG -stdtemp ) / ( Met_Data%TEMPG -svp3 ) ) - End Where - Met_Data%QSS_GRND = Es_Grnd * 0.622 / ( Met_Data%PRSFC - Es_Grnd ) - Nullify( Es_Grnd ) - - Es_Air => BUFF2D - Where( Met_Data%TEMP2 .Lt. stdtemp ) - Es_Air = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMP2 ) ) - Elsewhere - Es_Air = vp0 *Exp( svp2 * ( Met_Data%TEMP2 -stdtemp ) / ( Met_Data%TEMP2 -svp3 ) ) - End Where - Met_Data%RH = Met_Data%Q2 / ( Es_Air * 0.622 / ( Met_Data%PRSFC - Es_Air ) ) * 100.0 - Where( Met_Data%RH .Gt. 100.0 ) - Met_Data%RH = 100.0 - Elsewhere( Met_Data%RH .lt. 0.0 ) - Met_Data%RH = 0.0 - End Where - Nullify( Es_Air ) - -C-------------------------------- MET_DOT_3D -------------------------------- - If ( .Not. INTERPX( MET_DOT_3D, vname_uc, PNAME, - & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, - & JDATE, JTIME, Met_Data%UWIND ) ) Then - XMSG = MSG1 // TRIM( vname_uc ) // ' from ' // MET_DOT_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - - If ( .Not. INTERPX( MET_DOT_3D, vname_vc, PNAME, - & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, - & JDATE, JTIME, Met_Data%VWIND ) ) Then - XMSG = MSG1 // TRIM( vname_vc ) // ' from ' // MET_DOT_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - -C get ghost values for wind fields in case of free trop. - CALL SUBST_COMM ( Met_Data%UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) - CALL SUBST_COMM ( Met_Data%VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) - -C-------------------------------- Calculated Variables -------------------------------- - Met_Data%DZF = Met_Data%ZF - EOSHIFT(Met_Data%ZF, Shift = -1, Boundary = 0.0, Dim = 3) - - Met_Data%RDEPVHT = 1.0 / Met_Data%ZF( :,:,1 ) - - IF ( MINKZ ) THEN - Met_Data%KZMIN = KZL - DO L = 1, NLAYS - Where( Met_Data%ZF( :,:,L ) .LE. KZMAXL ) - Met_Data%KZMIN( :,:,L ) = KZL + ( KZU - KZL ) * 0.01 * Grid_data%PURB - End Where - End Do - ELSE - Met_Data%KZMIN = KZ0UT - END IF - - TV => BUFF3D - TV = Met_Data%TA * ( 1.0 + 0.608 * Met_Data%QV ) - Met_Data%THETAV = TV * ( P0 / Met_Data%PRES ) ** 0.286 - Nullify( TV ) - -C------ Updating MOL, then WSTAR, MOLI, HOL - DO R = 1, MY_NROWS - DO C = 1, MY_NCOLS - ! CPAIR = 1004.67 * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) - CPAIR = CPD * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) - TMPFX = Met_Data%HFX( C,R ) / ( CPAIR * Met_Data%DENS( C,R,1 ) ) - TMPVTCON = 1.0 + 0.608 * Met_Data%QV( C,R,1 ) ! Conversion factor for virtual temperature - TST = -TMPFX / Met_Data%USTAR( C,R ) - IF ( Met_Data%TA( C,R,1 ) .GT. STDTEMP ) THEN - LV = LV0 - ( 0.00237 * ( Met_Data%TA( C,R,1 ) - STDTEMP ) ) * 1.0E6 - ELSE - LV = 2.83E6 ! Latent heat of sublimation at 0C from Stull (1988) (J/KG) - END IF - QST = -( Met_Data%LH( C,R ) / LV ) - & / ( Met_Data%USTAR( C,R ) * Met_Data%DENS( C,R,1 ) ) - TSTV = TST * TMPVTCON + Met_Data%THETAV( C,R,1 ) * 0.608 * QST - IF ( ABS( TSTV ) .LT. 1.0E-6 ) THEN - TSTV = SIGN( 1.0E-6, TSTV ) - END IF - Met_Data%MOL( C,R ) = Met_Data%THETAV( C,R,1 ) - & * Met_Data%USTAR( C,R ) ** 2 / ( karman * GRAV * TSTV ) - IF ( Met_Data%MOL( C,R ) .LT. 0.0 ) THEN - Met_Data%WSTAR( C,R ) = Met_Data%USTAR( C,R ) * ( Met_Data%PBL( C,R ) - & / ( karman * ABS( Met_Data%MOL( C,R ) ) ) ) ** 0.333333 - ELSE - Met_Data%WSTAR( C,R ) = 0.0 - END IF - - END DO - END DO - - Met_Data%MOLI = 1.0 / Met_Data%MOL - Met_Data%HOL = Met_Data%PBL / Met_Data%MOL -C------ - - Met_Data%CONVCT = .FALSE. - DO R = 1, MY_NROWS - DO C = 1, MY_NCOLS - DO L = 1, NLAYS - IF ( Met_Data%PBL( C,R ) .LT. Met_Data%ZF( C,R,L ) ) THEN - LP = L; EXIT - END IF - END DO - - Met_Data%LPBL( C,R ) = LP - If ( LP .Eq. 1 ) Then - FINT = ( Met_Data%PBL( C,R ) ) - & / ( Met_Data%ZF( C,R,LP ) ) - Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) - & + X3FACE_GD( LP-1 ) - Else - FINT = ( Met_Data%PBL( C,R ) - Met_Data%ZF( C,R,LP-1 ) ) - & / ( Met_Data%ZF( C,R,LP ) - Met_Data%ZF( C,R,LP-1 ) ) - Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) - & + X3FACE_GD( LP-1 ) - End If - END DO - END DO - Where( Met_Data%THETAV( :,:,1 ) - Met_Data%THETAV( :,:,2 ) .Gt. EPS .And. - & Met_Data%HOL .Lt. -0.02 .And. Met_Data%LPBL .Gt. 3 ) - Met_Data%CONVCT = .True. - End Where - - Return - End Subroutine GET_MET - - End Module ASX_DATA_MOD diff --git a/src/model/src/ASX_DATA_MOD.F~ b/src/model/src/ASX_DATA_MOD.F~ deleted file mode 100755 index 0e7b79e..0000000 --- a/src/model/src/ASX_DATA_MOD.F~ +++ /dev/null @@ -1,1459 +0,0 @@ -!------------------------------------------------------------------------! -! The Community Multiscale Air Quality (CMAQ) system software is in ! -! continuous development by various groups and is based on information ! -! from these groups: Federal Government employees, contractors working ! -! within a United States Government contract, and non-Federal sources ! -! including research institutions. These groups give the Government ! -! permission to use, prepare derivative works of, and distribute copies ! -! of their work in the CMAQ system to the public and to permit others ! -! to do so. The United States Environmental Protection Agency ! -! therefore grants similar permission to use the CMAQ system software, ! -! but users are requested to provide copies of derivative works or ! -! products designed to operate in the CMAQ system to the United States ! -! Government without restrictions as to use by others. Software ! -! that is used with the CMAQ system but distributed under the GNU ! -! General Public License or the GNU Lesser General Public License is ! -! subject to their copyright restrictions. ! -!------------------------------------------------------------------------! - -C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - Module ASX_DATA_MOD - -C----------------------------------------------------------------------- -C Function: User-defined types - -C Revision History: -C 19 Aug 2014 J.Bash: initial implementation -C 17 July 2015 H.Foroutan: Updated the calculation of MOL, MOLI, HOL, and WSTAR -C 25 Aug 2015 H. Pye: Added IEPOX, HACET surrogates -C modified PROPNN and H2O2 -C Increased ar for ozone from 8 to 12. -C Change meso from 0.1 to 0 for some org. nitrates -C Changes based on Nguyen et al. 2015 PNAS and SOAS -C -C---------Notes -C * Updates based on literature review 7/96 JEP -C # Diff and H based on Wesely (1988) same as RADM -C + Estimated by JEP 2/97 -C @ Updated by JEP 9/01 -C ~ Added by YW 1/02. Dif0 based on Massman (1998). Henry's Law constant -C is defined here as: h=cg/ca, where cg is the concentration of a species -C in gas-phase, and ca is its aqueous-phase concentration. The smaller h, -C the larger solubility. Henry's Law constant in another definition (KH): -C KH = ca/pg [M/atm], KH = KH0 * exp(-DKH/R(1/T-1/T0)), where KH0 and -DKH -C values are from Rolf Sander (1999). h=1/(KH*R*T). -C ** Update by DBS based on estimates by JEP 1/03 -C ^^ From Bill Massman, personal communication 4/03 -C ## Diffusivity calculated by SPARC, reactivity = other aldehydes -C ++ Dif0 in Massman is diffusivity at temperature 0C and 1 atm (101.325kPa), so -C chemicals that were not in Massman's paper need to be adjusted. We assume -C JEP's original values were for 25C and 1 atm. -C % Added by G. Sarwar (10/04) -C $ Added by R. Bullock (02/05) HG diffusivity is from Massman (1999). -C HGIIGAS diffusivity calculated from the HG value and a mol. wt. scaling -C factor of MW**(-2/3) from EPA/600/3-87/015. ORD, Athens, GA. HGIIGAS -C mol.wt. used is that of HgCl2. Reactivity of HG is 1/20th of NO and NO2 -C values based on general atmospheric lifetimes of each species. Reactivity -C of HGIIGAS is based on HNO3 surrogate. -C @@ Mesophyll resistances for NO, NO2, and CO added by J. Pleim (07/07) based -C on values in Pleim, Venkatram, and Yamartino, 1984: ADOM/TADAP Model -C Development Program, Volume 4, The Dry Deposition Module. ERT, Inc., -C Concord, MA (peer reviewed). -C ~~ Reactivity for PAN changed from 4.0 to 16.0 by J. Pleim (07/07) based on -C comparisons with Turnipseed et al., JGR, 2006. -C %% Species ICL1 and ICL2 are removed, not used in CB05. G. Sarwar (07/07) -C <> Hazardous Air Pollutants that are believed to undergo significant dry -C deposition. Hydrazine and triethylamine reactivities are based on analogies -C to NH3. Maleic anhydride reactivity is assumed similar to aldehydes. -C Toluene diisocyanate and hexamethylene diisocyanate reactivities are -C assumed to be similar to SO2. Diffusivities are calculated with standard -C formulas. W. Hutzell (04/08) -C %% G. Sarwar: added data for iodine and bromine species (03/2016) -C %% B. Hutzell: added dry deposition data for methane, acrylic acid, methyl chloride, -C and acetonitrile (09/2016) -C------------------------------------------------------------------------------- - - Use GRID_CONF ! horizontal & vertical domain specifications - Use LSM_MOD ! Land surface data - Use DEPVVARS, Only: ltotg - - Implicit None - - Include SUBST_CONST ! constants - - Type :: MET_Type -!> 2-D meteorological fields: - Real, Allocatable :: RDEPVHT ( :,: ) ! air dens / dep vel ht - Real, Allocatable :: DENS1 ( :,: ) ! layer 1 air density - Real, Allocatable :: PRSFC ( :,: ) ! surface pressure [Pa] - Real, Allocatable :: Q2 ( :,: ) ! 2 meter water vapor mixing ratio [kg/kg] - Real, Allocatable :: QSS_GRND ( :,: ) ! ground saturation water vapor mixing ratio [kg/kg] - Real, Allocatable :: RH ( :,: ) ! relative humidity [ratio] - Real, Allocatable :: RA ( :,: ) ! aerodynamic resistnace [s/m] - Real, Allocatable :: RS ( :,: ) ! stomatal resistnace [s/m] - Real, Allocatable :: RC ( :,: ) ! convective precipitation [cm] - Real, Allocatable :: RN ( :,: ) ! non-convective precipitation [mc] - Real, Allocatable :: RGRND ( :,: ) ! Solar radiation at the ground [W/m**2] - Real, Allocatable :: HFX ( :,: ) ! Sensible heat flux [W/m**2] - Real, Allocatable :: LH ( :,: ) ! Latent heat flux [W/m**2] - Real, Allocatable :: SNOCOV ( :,: ) ! Snow cover [1=yes, 0=no] - Real, Allocatable :: TEMP2 ( :,: ) ! two meter temperature [K] - Real, Allocatable :: TEMPG ( :,: ) ! skin temperature [K] - Real, Allocatable :: TSEASFC ( :,: ) ! SST [K] - Real, Allocatable :: USTAR ( :,: ) ! surface friction velocity [m/s] - Real, Allocatable :: VEG ( :,: ) ! fractional vegetation coverage [ratio] - Real, Allocatable :: LAI ( :,: ) ! grid cell leaf area index [m**2/m**2] - Real, Allocatable :: WR ( :,: ) ! precip intercepted by canopy [m] - Real, Allocatable :: WSPD10 ( :,: ) ! 10-m wind speed [m/s] - Real, Allocatable :: WSTAR ( :,: ) ! convective velocity scale [m/s] - Real, Allocatable :: Z0 ( :,: ) ! roughness length [m] - Real, Allocatable :: SOIM1 ( :,: ) ! 1 cm soil moisture [m**3/m**3] - Real, Allocatable :: SOIM2 ( :,: ) ! 1 m soil moisture [m**3/m**3] - Real, Allocatable :: SOIT1 ( :,: ) ! 1 cm soil temperature [K] - Real, Allocatable :: SOIT2 ( :,: ) ! 1 m soil temperature [K] - Real, Allocatable :: SEAICE ( :,: ) ! Sea ice coverage [%] - Real, Allocatable :: MOL ( :,: ) ! Monin-Obukhov length [m] - Real, Allocatable :: MOLI ( :,: ) ! inverse of Monin-Obukhov length [m] - Real, Allocatable :: HOL ( :,: ) ! PBL over Obukhov length - Real, Allocatable :: XPBL ( :,: ) ! PBL sigma height - Integer, Allocatable :: LPBL ( :,: ) ! PBL layer - Logical, Allocatable :: CONVCT ( :,: ) ! convection flag - Real, Allocatable :: PBL ( :,: ) ! pbl height (m) - Real, Allocatable :: NACL_EMIS( :,: ) ! NACL mass emission rate of particles with d <10 um (g/m2/s) - -!> FENGSHA option - Real, Allocatable :: CLAYF ( :,: ) ! Fractional Clay Content - Real, Allocatable :: SANDF ( :,: ) ! Fractional Sand Content - Real, Allocatable :: DRAG ( :,: ) ! Drag Partion - Real, Allocatable :: UTHR ( :,: ) ! Dry Threshold Friction Velocity - -!> U and V wind components on the cross grid points - Real, Allocatable :: UWIND ( :,:,: ) ! [m/s] - Real, Allocatable :: VWIND ( :,:,: ) ! [m/s] -!> 3-D meteorological fields: - Real, Allocatable :: KZMIN ( :,:,: ) ! minimum Kz [m**2/s] - Real, Allocatable :: PRES ( :,:,: ) ! layer 1 pressure [Pa] - Real, Allocatable :: QV ( :,:,: ) ! water vapor mixing ratio - Real, Allocatable :: QC ( :,:,: ) ! cloud water mixing ratio - Real, Allocatable :: THETAV ( :,:,: ) ! potential temp - Real, Allocatable :: TA ( :,:,: ) ! temperature (K) - Real, Allocatable :: ZH ( :,:,: ) ! mid-layer height above ground [m] - Real, Allocatable :: ZF ( :,:,: ) ! layer height [m] - Real, Allocatable :: DZF ( :,:,: ) ! layer surface thickness - Real, Allocatable :: DENS ( :,:,: ) ! air density - Real, Allocatable :: RJACM ( :,:,: ) ! reciprocal mid-layer Jacobian - Real, Allocatable :: RJACF ( :,:,: ) ! reciprocal full-layer Jacobian - Real, Allocatable :: RRHOJ ( :,:,: ) ! reciprocal density X Jacobian - End Type MET_Type - - Type :: GRID_Type -!> Grid infomation: -!> Vertical information - Real, Allocatable :: DX3F ( : ) ! sigma layer surface thickness ! vdiffacmx.F - Real, Allocatable :: RDX3F ( : ) ! reciprocal sigma layer thickness ! EMIS_DEFN.F, sedi.F, vdiffacmx.F, vdiffproc.F - Real, Allocatable :: RDX3M ( : ) ! reciprocal sigma midlayer thickness ! vdiffproc.F -!> Horizontal Information: - Real, Allocatable :: RMSFX4 ( :,: ) ! inverse map scale factor ** 4 - Real, Allocatable :: LON ( :,: ) ! longitude - Real, Allocatable :: LAT ( :,: ) ! latitude - Real, Allocatable :: LWMASK ( :,: ) ! land water mask - Real, Allocatable :: OCEAN ( :,: ) ! Open ocean - Real, Allocatable :: SZONE ( :,: ) ! Surf zone - Real, Allocatable :: PURB ( :,: ) ! percent urban [%] - Integer, Allocatable :: SLTYP ( :,: ) ! soil type [category] - Real, Allocatable :: WSAT ( :,: ) ! soil wilting point - Real, Allocatable :: WWLT ( :,: ) ! soil wilting point - Real, Allocatable :: BSLP ( :,: ) ! B Slope - Real, Allocatable :: WRES ( :,: ) ! Soil residual moisture point - Real, Allocatable :: WFC ( :,: ) ! soil field capacity -! Real, Allocatable :: RHOB ( :,: ) ! soil bulk density - Real, Allocatable :: LUFRAC ( :,:,: ) ! land use fraction (col,row,lu_type)[ratio] -C Land use information: - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. - End Type GRID_Type - - Type :: MOSAIC_Type ! (col,row,lu) - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: LU_Type ( : ) ! general land use type e.g. water, forest, etc. -!> Sub grid cell meteorological variables: - Real, Allocatable :: USTAR ( :,:,: ) ! surface friction velocity [m/s] - Real, Allocatable :: LAI ( :,:,: ) ! leaf area index [m**2/m**2] - Real, Allocatable :: VEG ( :,:,: ) ! vegetation fraction [ratio] - Real, Allocatable :: Z0 ( :,:,: ) ! vegetation fraction [ratio] - Real, Allocatable :: DELTA ( :,:,: ) ! Surface wetness [ratio] -!> Sub grid cell resistances - Real, Allocatable :: RA ( :,:,: ) ! aerodynamic resistance [s/m] - Real, Allocatable :: RSTW ( :,:,: ) ! Stomatal Resistance of water [s/m] - Real, Allocatable :: RINC ( :,:,: ) ! In-canopy resistance [s/m] - End Type MOSAIC_Type - - Type :: ChemMos_Type ! (col,row,lu,spc) - Character( 16 ), Allocatable :: NAME ( : ) ! LU name - Character( 16 ), Allocatable :: Lu_Type ( : ) ! general land use type e.g. water, forest, etc. - Character( 16 ), Allocatable :: SubName ( : ) ! Deposition species name -!> Sub grid cell chemically dependent resistances - Real, Allocatable :: Rb ( :,:,:,: ) ! quasi-laminar boundary layer resistance [s/m] - Real, Allocatable :: Rst ( :,:,:,: ) ! stomatal resistance [s/m] - Real, Allocatable :: Rgc ( :,:,:,: ) ! Canopy covered soil resistance [s/m] - Real, Allocatable :: Rgb ( :,:,:,: ) ! Barron soil resistance [s/m] - Real, Allocatable :: Rcut ( :,:,:,: ) ! soil resistance [s/m] - Real, Allocatable :: Rwat ( :,:,:,: ) ! surface water resistance [s/m] -!> Sub grid cell compensation point - Real, Allocatable :: Catm ( :,:,:,: ) ! Atmospheric [ppm] - Real, Allocatable :: CZ0 ( :,:,:,: ) ! compensation point at Z0 [ppm] - Real, Allocatable :: Cleaf( :,:,:,: ) ! Leaf compensation point [ppm] - Real, Allocatable :: Cstom( :,:,:,: ) ! Stomatal compensation point [ppm] - Real, Allocatable :: Ccut ( :,:,:,: ) ! Cuticular compensation point [ppm] - Real, Allocatable :: Csoil( :,:,:,: ) ! Soil compensation point [ppm] - End Type ChemMos_Type - - Type( MET_Type ), Save :: Met_Data - Type( GRID_Type ), Save :: Grid_Data - Type( MOSAIC_Type ), Save :: Mosaic_Data - Type( ChemMos_Type ), Save :: ChemMos_Data - - Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module -!> M3 asx constants - Real, Parameter :: a0 = 8.0 ! [dim'less] - Real, Parameter :: d3 = 1.38564e-2 ! [dim'less] - Real, Parameter :: dwat = 0.2178 ! [cm^2/s] at 273.15K - Real, Parameter :: hplus_ap = 1.0e-6 ! pH=6.0 leaf apoplast solution Ph (Massad et al 2008) - Real, Parameter :: hplus_def = 1.0e-5 ! pH=5.0 - Real, Parameter :: hplus_east = 1.0e-5 ! pH=5.0 - Real, Parameter :: hplus_h2o = 7.94328e-9 ! 10.0**(-8.1) - Real, Parameter :: hplus_west = 3.16228e-6 ! 10.0**(-5.5) - Real, Parameter :: kvis = 0.132 ! [cm^2 / s] at 273.15K - Real, Parameter :: pr = 0.709 ! [dim'less] - Real, Parameter :: rcut0 = 3000.0 ! [s/m] - Real, Parameter :: rcw0 = 125000.0 ! acc'd'g to Padro and - Real, Parameter :: resist_max = 1.0e30 ! maximum resistance - Real, Parameter :: rg0 = 1000.0 ! [s/m] - Real, Parameter :: rgwet0 = 25000.0 ! [s/m] - Real, Parameter :: rsndiff = 10.0 ! snow diffusivity fac - Real, Parameter :: rsnow0 = 1000.0 - Real, Parameter :: svp2 = 17.67 ! from MM5 and WRF - Real, Parameter :: svp3 = 29.65 ! from MM5 and WRF - Real, Parameter :: rt25inK = 1.0/(stdtemp + 25.0) ! 298.15K = 25C - Real, Parameter :: twothirds = 2.0 / 3.0 - Real, Parameter :: betah = 5.0 ! WRF 3.6 px uses Dyer - Real, Parameter :: gamah = 16.0 - Real, Parameter :: pr0 = 0.95 - Real, Parameter :: karman = 0.40 - Real, Parameter :: f3min = 0.25 - Real, Parameter :: ftmin = 0.0000001 ! m/s - Real, Parameter :: nscat = 16.0 - Real, Parameter :: rsmax = 5000.0 ! s/m - - Real :: ar ( ltotg ) ! reactivity relative to HNO3 - Real :: dif0 ( ltotg ) ! molecular diffusivity [cm2/s] - Real :: lebas ( ltotg ) ! Le Bas molar volume [cm3/mol ] - Real :: meso ( ltotg ) ! Exception for species that - ! react with cell walls. fo in - ! Wesely 1989 eq 6. - Character( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST - - Logical, Save :: MET_INITIALIZED = .false. - Real, Save :: CONVPA ! Pressure conversion factor file units to Pa - Logical, Save :: MINKZ - Logical, Save :: CSTAGUV ! Winds are available with C stagger? - Logical, Save :: ifwr = .false. - - Public :: INIT_MET - - Logical, Private, Save :: ifsst = .false. - Logical, Private, Save :: ifq2 = .false. - Logical, Private, Save :: rinv = .True. - Logical, Private, Save :: iflh = .false. - - Integer, Private :: C, R, L, S ! loop induction variables - Integer, Private :: SPC - Character( 16 ), Private, Save :: vname_rc, vname_rn, vname_uc, vname_vc - Real, Private, Save :: P0 ! reference pressure (100000.0 Pa) for Potential Temperature, note that in meteorology they do not use the SI 1 ATM. - - Integer, Private, Save :: LOGDEV - Integer, Private, Save :: GXOFF, GYOFF ! global origin offset from file - Integer, Private, Save :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ! MET_CRO_3D - Integer, Private, Save :: STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ! MET_DOT_3D - Integer, Private, Save :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ! MET_CRO_2D - Integer, Private, Save :: STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ! OCEAN_1 - - Real, Pointer, Private :: BUFF1D( : ) ! 1D temp var number of layers - Real, Pointer, Private :: BUFF2D( :,: ) ! 2D temp var - Real, Pointer, Private :: BUFF3D( :,:,: ) ! 3D temp var - -! FENGSHA option control - CHARACTER( 20 ), SAVE :: CTM_FENGSHA = 'CTM_FENGSHA '! env var for in-line - LOGICAL, PUBLIC, SAVE :: FENGSHA ! flag for fengsha option - - INTEGER IOSX ! i/o and allocate memory status - - DATA subname( 1), dif0( 1), ar( 1), meso( 1), lebas( 1) / 'SO2 ', 0.1089, 10.0, 0.0, 35.0/ - DATA subname( 2), dif0( 2), ar( 2), meso( 2), lebas( 2) / 'H2SO4 ', 0.1091, 8000.0, 0.0, 49.0/ - DATA subname( 3), dif0( 3), ar( 3), meso( 3), lebas( 3) / 'NO2 ', 0.1361, 2.0, 0.1, 21.0/ - DATA subname( 4), dif0( 4), ar( 4), meso( 4), lebas( 4) / 'NO ', 0.1802, 2.0, 0.0, 14.0/ - DATA subname( 5), dif0( 5), ar( 5), meso( 5), lebas( 5) / 'O3 ', 0.1444, 12.0, 1.0, 21.0/ - DATA subname( 6), dif0( 6), ar( 6), meso( 6), lebas( 6) / 'HNO3 ', 0.1067, 8000.0, 0.0, 35.0/ - DATA subname( 7), dif0( 7), ar( 7), meso( 7), lebas( 7) / 'H2O2 ', 0.1300,34000.0, 1.0, 28.0/ !ar=34,000 such that r_cut=0.7 s/m as in Nguyen et al. 2015 - DATA subname( 8), dif0( 8), ar( 8), meso( 8), lebas( 8) / 'ACETALDEHYDE ', 0.1111, 10.0, 0.0, 56.0/ - DATA subname( 9), dif0( 9), ar( 9), meso( 9), lebas( 9) / 'FORMALDEHYDE ', 0.1554, 10.0, 0.0, 35.0/ - DATA subname( 10), dif0( 10), ar( 10), meso( 10), lebas( 10) / 'METHYLHYDROPEROX', 0.1179, 10.0, 0.3, 49.0/ !meso change from 0.1 to 0.3, Wolfe and Thornton 2011 ACP per J. Bash - DATA subname( 11), dif0( 11), ar( 11), meso( 11), lebas( 11) / 'PEROXYACETIC_ACI', 0.0868, 20.0, 0.1, 70.0/ - DATA subname( 12), dif0( 12), ar( 12), meso( 12), lebas( 12) / 'ACETIC_ACID ', 0.0944, 20.0, 0.0, 63.0/ - DATA subname( 13), dif0( 13), ar( 13), meso( 13), lebas( 13) / 'NH3 ', 0.1978, 20.0, 0.0, 28.0/ - DATA subname( 14), dif0( 14), ar( 14), meso( 14), lebas( 14) / 'PAN ', 0.0687, 16.0, 0.1, 91.0/ - DATA subname( 15), dif0( 15), ar( 15), meso( 15), lebas( 15) / 'HNO2 ', 0.1349, 20.0, 0.1, 28.0/ - DATA subname( 16), dif0( 16), ar( 16), meso( 16), lebas( 16) / 'CO ', 0.1807, 5.0, 0.0, 14.0/ - DATA subname( 17), dif0( 17), ar( 17), meso( 17), lebas( 17) / 'METHANOL ', 0.1329, 2.0, 0.0, 42.0/ - DATA subname( 18), dif0( 18), ar( 18), meso( 18), lebas( 18) / 'N2O5 ', 0.0808, 5000.0, 0.0, 49.0/ - DATA subname( 19), dif0( 19), ar( 19), meso( 19), lebas( 19) / 'NO3 ', 0.1153, 5000.0, 0.0, 28.0/ - DATA subname( 20), dif0( 20), ar( 20), meso( 20), lebas( 20) / 'GENERIC_ALDEHYDE', 0.0916, 10.0, 0.0, 56.0/ - DATA subname( 21), dif0( 21), ar( 21), meso( 21), lebas( 21) / 'CL2 ', 0.1080, 10.0, 0.0, 49.0/ - DATA subname( 22), dif0( 22), ar( 22), meso( 22), lebas( 22) / 'HOCL ', 0.1300, 10.0, 0.0, 38.5/ - DATA subname( 23), dif0( 23), ar( 23), meso( 23), lebas( 23) / 'HCL ', 0.1510, 8000.0, 0.0, 31.5/ - DATA subname( 24), dif0( 24), ar( 24), meso( 24), lebas( 24) / 'FMCL ', 0.1094, 10.0, 0.0, 45.5/ - DATA subname( 25), dif0( 25), ar( 25), meso( 25), lebas( 25) / 'HG ', 0.1194, 0.1, 0.0, 14.8/ ! lebas not used - DATA subname( 26), dif0( 26), ar( 26), meso( 26), lebas( 26) / 'HGIIGAS ', 0.0976, 8000.0, 0.0, 95.0/ ! estimation from back calculating to get dw25 = 1.04e-5 (Garland et al, 1965) - DATA subname( 27), dif0( 27), ar( 27), meso( 27), lebas( 27) / 'TECDD_2378 ', 0.0525, 2.0, 0.0, 217.0/ - DATA subname( 28), dif0( 28), ar( 28), meso( 28), lebas( 28) / 'PECDD_12378 ', 0.0508, 2.0, 0.0, 234.5/ - DATA subname( 29), dif0( 29), ar( 29), meso( 29), lebas( 29) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 30), dif0( 30), ar( 30), meso( 30), lebas( 30) / 'HXCDD_123678 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 31), dif0( 31), ar( 31), meso( 31), lebas( 31) / 'HXCDD_123478 ', 0.0494, 2.0, 0.0, 252.0/ - DATA subname( 32), dif0( 32), ar( 32), meso( 32), lebas( 32) / 'HPCDD_1234678 ', 0.0480, 2.0, 0.0, 269.5/ - DATA subname( 33), dif0( 33), ar( 33), meso( 33), lebas( 33) / 'OTCDD ', 0.0474, 2.0, 0.0, 287.0/ - DATA subname( 34), dif0( 34), ar( 34), meso( 34), lebas( 34) / 'TECDF_2378 ', 0.0534, 2.0, 0.0, 210.0/ - DATA subname( 35), dif0( 35), ar( 35), meso( 35), lebas( 35) / 'PECDF_12378 ', 0.0517, 2.0, 0.0, 227.5/ - DATA subname( 36), dif0( 36), ar( 36), meso( 36), lebas( 36) / 'PECDF_23478 ', 0.0517, 2.0, 0.0, 227.5/ - DATA subname( 37), dif0( 37), ar( 37), meso( 37), lebas( 37) / 'HXCDF_123478 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 38), dif0( 38), ar( 38), meso( 38), lebas( 38) / 'HXCDF_123678 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 39), dif0( 39), ar( 39), meso( 39), lebas( 39) / 'HXCDF_234678 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 40), dif0( 40), ar( 40), meso( 40), lebas( 40) / 'HXCDF_123789 ', 0.0512, 2.0, 0.0, 245.0/ - DATA subname( 41), dif0( 41), ar( 41), meso( 41), lebas( 41) / 'HPCDF_1234678 ', 0.0487, 2.0, 0.0, 262.5/ - DATA subname( 42), dif0( 42), ar( 42), meso( 42), lebas( 42) / 'HPCDF_1234789 ', 0.0487, 2.0, 0.0, 262.5/ - DATA subname( 43), dif0( 43), ar( 43), meso( 43), lebas( 43) / 'OTCDF ', 0.0474, 2.0, 0.0, 280.0/ - DATA subname( 44), dif0( 44), ar( 44), meso( 44), lebas( 44) / 'NAPHTHALENE ', 0.0778, 4.0, 0.0, 119.0/ - DATA subname( 45), dif0( 45), ar( 45), meso( 45), lebas( 45) / '1NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ - DATA subname( 46), dif0( 46), ar( 46), meso( 46), lebas( 46) / '2NITRONAPHTHALEN', 0.0692, 4.0, 0.0, 133.0/ - DATA subname( 47), dif0( 47), ar( 47), meso( 47), lebas( 47) / '14NAPHTHOQUINONE', 0.0780, 4.0, 0.0, 119.0/ - DATA subname( 48), dif0( 48), ar( 48), meso( 48), lebas( 48) / 'HEXAMETHYLE_DIIS', 0.0380, 10.0, 0.0, 196.0/ - DATA subname( 49), dif0( 49), ar( 49), meso( 49), lebas( 49) / 'HYDRAZINE ', 0.4164, 20.0, 0.0, 42.0/ - DATA subname( 50), dif0( 50), ar( 50), meso( 50), lebas( 50) / 'MALEIC_ANHYDRIDE', 0.0950, 10.0, 0.0, 70.0/ - DATA subname( 51), dif0( 51), ar( 51), meso( 51), lebas( 51) / '24-TOLUENE_DIIS ', 0.0610, 10.0, 0.0, 154.0/ - DATA subname( 52), dif0( 52), ar( 52), meso( 52), lebas( 52) / 'TRIETHYLAMINE ', 0.0881, 20.0, 0.0, 154.0/ - DATA subname( 53), dif0( 53), ar( 53), meso( 53), lebas( 53) / 'ORG_NTR ', 0.0607, 16.0, 0.0, 160.0/ ! assumes 58.2% C5H11O4N and 41.8% C5H11O3N - DATA subname( 54), dif0( 54), ar( 54), meso( 54), lebas( 54) / 'HYDROXY_NITRATES', 0.0609, 16.0, 0.0, 156.1/ - DATA subname( 55), dif0( 55), ar( 55), meso( 55), lebas( 55) / 'MPAN ', 0.0580, 16.0, 0.1, 133.0/ - DATA subname( 56), dif0( 56), ar( 56), meso( 56), lebas( 56) / 'PPN ', 0.0631, 16.0, 0.1, 118.2/ - DATA subname( 57), dif0( 57), ar( 57), meso( 57), lebas( 57) / 'MVK ', 0.0810, 8.0, 1.0, 88.8/ - DATA subname( 58), dif0( 58), ar( 58), meso( 58), lebas( 58) / 'DINTR ', 0.0617, 16.0, 0.1, 169.8/ - DATA subname( 59), dif0( 59), ar( 59), meso( 59), lebas( 59) / 'NTR_ALK ', 0.0688, 16.0, 0.1, 133.0/ - DATA subname( 60), dif0( 60), ar( 60), meso( 60), lebas( 60) / 'NTR_OH ', 0.0665, 16.0, 0.1, 140.4/ - DATA subname( 61), dif0( 61), ar( 61), meso( 61), lebas( 61) / 'HYDROXY_NITRATES', 0.0646, 16.0, 0.0, 147.8/ - DATA subname( 62), dif0( 62), ar( 62), meso( 62), lebas( 62) / 'PROPNN ', 0.0677, 16.0, 0.0, 133.0/ - DATA subname( 63), dif0( 63), ar( 63), meso( 63), lebas( 63) / 'NITRYL_CHLORIDE ', 0.0888, 8.0, 0.0, 45.5/ ! dif0 estimated following Erickson III et al., JGR, 104, D7, 8347-8372, 1999 - DATA subname( 64), dif0( 64), ar( 64), meso( 64), lebas( 64) / 'ISOPNN ',0.0457, 8.0, 0.0, 206.8/ - DATA subname( 65), dif0( 65), ar( 65), meso( 65), lebas( 65) / 'MTNO3 ',0.0453, 8.0, 0.0, 251.2/ - DATA subname( 66), dif0( 66), ar( 66), meso( 66), lebas( 66) / 'IEPOX ',0.0579, 8.0, 0.0, 110.8/ - DATA subname( 67), dif0( 67), ar( 67), meso( 67), lebas( 67) / 'HACET ',0.1060, 8.0, 0.0, 72.6/ ! dif0 from Nguyen 2015 PNAS - DATA subname( 68), dif0( 68), ar( 68), meso( 68), lebas( 68) / 'SVALK1 ',0.0514, 20.0, 0.0, 280.5/ - DATA subname( 69), dif0( 69), ar( 69), meso( 69), lebas( 69) / 'SVALK2 ',0.0546, 20.0, 0.0, 275.6/ - DATA subname( 70), dif0( 70), ar( 70), meso( 70), lebas( 70) / 'SVBNZ1 ',0.0642, 20.0, 0.0, 134.1/ - DATA subname( 71), dif0( 71), ar( 71), meso( 71), lebas( 71) / 'SVBNZ2 ',0.0726, 20.0, 0.0, 127.5/ - DATA subname( 72), dif0( 72), ar( 72), meso( 72), lebas( 72) / 'SVISO1 ',0.0733, 20.0, 0.0, 126.3/ - DATA subname( 73), dif0( 73), ar( 73), meso( 73), lebas( 73) / 'SVISO2 ',0.0729, 20.0, 0.0, 123.8/ - DATA subname( 74), dif0( 74), ar( 74), meso( 74), lebas( 74) / 'SVPAH1 ',0.0564, 20.0, 0.0, 235.7/ - DATA subname( 75), dif0( 75), ar( 75), meso( 75), lebas( 75) / 'SVPAH2 ',0.0599, 20.0, 0.0, 231.5/ - DATA subname( 76), dif0( 76), ar( 76), meso( 76), lebas( 76) / 'SVSQT ',0.0451, 20.0, 0.0, 346.5/ - DATA subname( 77), dif0( 77), ar( 77), meso( 77), lebas( 77) / 'SVTOL1 ',0.0637, 20.0, 0.0, 153.7/ - DATA subname( 78), dif0( 78), ar( 78), meso( 78), lebas( 78) / 'SVTOL2 ',0.0607, 20.0, 0.0, 194.1/ - DATA subname( 79), dif0( 79), ar( 79), meso( 79), lebas( 79) / 'SVTRP1 ',0.0603, 20.0, 0.0, 194.9/ - DATA subname( 80), dif0( 80), ar( 80), meso( 80), lebas( 80) / 'SVTRP2 ',0.0559, 20.0, 0.0, 218.8/ - DATA subname( 81), dif0( 81), ar( 81), meso( 81), lebas( 81) / 'SVXYL1 ',0.0610, 20.0, 0.0, 154.6/ - DATA subname( 82), dif0( 82), ar( 82), meso( 82), lebas( 82) / 'SVXYL2 ',0.0585, 20.0, 0.0, 194.6/ - DATA subname( 83), dif0( 83), ar( 83), meso( 83), lebas( 83) / 'IO ',0.1002, 8.0, 0.0, 44.4/ - DATA subname( 84), dif0( 84), ar( 84), meso( 84), lebas( 84) / 'OIO ',0.0938, 8.0, 0.0, 51.8/ - DATA subname( 85), dif0( 85), ar( 85), meso( 85), lebas( 85) / 'I2O2 ',0.0732, 8.0, 0.0, 88.8/ - DATA subname( 86), dif0( 86), ar( 86), meso( 86), lebas( 86) / 'I2O3 ',0.0707, 8.0, 0.0, 96.2/ - DATA subname( 87), dif0( 87), ar( 87), meso( 87), lebas( 87) / 'I2O4 ',0.0684, 8.0, 0.0, 103.6/ - DATA subname( 88), dif0( 88), ar( 88), meso( 88), lebas( 88) / 'HI ',0.1045, 8.0, 0.0, 40.7/ - DATA subname( 89), dif0( 89), ar( 89), meso( 89), lebas( 89) / 'HOI ',0.0972, 8.0, 0.0, 48.1/ - DATA subname( 90), dif0( 90), ar( 90), meso( 90), lebas( 90) / 'INO ',0.0882, 8.0, 0.0, 60.9/ - DATA subname( 91), dif0( 91), ar( 91), meso( 91), lebas( 91) / 'INO2 ',0.0883, 20.0, 0.0, 69.2/ - DATA subname( 92), dif0( 92), ar( 92), meso( 92), lebas( 92) / 'IONO2 ',0.0792, 8.0, 0.0, 77.5/ - DATA subname( 93), dif0( 93), ar( 93), meso( 93), lebas( 93) / 'BRO ',0.1144, 1.0, 0.0, 34.4/ - DATA subname( 94), dif0( 94), ar( 94), meso( 94), lebas( 94) / 'HOBR ',0.1101, 1.0, 0.0, 38.1/ - DATA subname( 95), dif0( 95), ar( 95), meso( 95), lebas( 95) / 'HBR ',0.1216, 2.0, 0.0, 30.7/ - DATA subname( 96), dif0( 96), ar( 96), meso( 96), lebas( 96) / 'BRONO2 ',0.0855, 1.0, 0.0, 67.5/ - DATA subname( 97), dif0( 97), ar( 97), meso( 97), lebas( 97) / 'BRNO2 ',0.0909, 1.0, 0.0, 59.2/ - DATA subname( 98), dif0( 98), ar( 98), meso( 98), lebas( 98) / 'BRCL ',0.0966, 1.0, 0.0, 51.6/ - DATA subname( 99), dif0( 99), ar( 99), meso( 99), lebas( 99) / 'DMS ',0.0926, 2.0, 0.0, 77.4/ - DATA subname(100), dif0(100), ar(100), meso(100), lebas(100) / 'MSA ',0.0896, 2.0, 0.0, 77.4/ - DATA subname(101), dif0(101), ar(101), meso(101), lebas(101) / 'METHANE ',0.2107, 2.0, 0.0, 29.6/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. - DATA subname(102), dif0(102), ar(102), meso(102), lebas(102) / 'ACRYACID ',0.0908, 2.0, 0.0, 63.2/ - DATA subname(103), dif0(103), ar(103), meso(103), lebas(103) / 'CARBSULFIDE ',0.1240, 5.0, 0.0, 51.5/ - DATA subname(104), dif0(104), ar(104), meso(104), lebas(104) / 'ACETONITRILE ',0.1280, 5.0, 0.0, 52.3/ - DATA subname(105), dif0(105), ar(105), meso(105), lebas(105) / '6_NITRO_O_CRESOL',0.0664, 16.0, 0.0, 155.0/ ! dif0, equation 9-22. Scwarzenbach et. (1993) Env. Org. Chem. - - CONTAINS - -C======================================================================= - Subroutine INIT_MET ( JDATE, JTIME, MOSAIC, ABFLUX, HGBIDI ) - -C----------------------------------------------------------------------- -C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; -C allocatable RDEPVHT, RJACM, RRHOJ -C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and -C mid-layer -C Tanya took JACOBF out of METCRO3D! Improvise -C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical -C domain specifications in one module -C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN -C----------------------------------------------------------------------- - - Use UTILIO_DEFN - - Implicit None - - Include SUBST_FILES_ID ! file name parameters - Include SUBST_CONST ! constants - -C Arguments: - Integer, Intent( IN ) :: JDATE, JTIME ! internal simulation date&time - Logical, Intent( IN ) :: MOSAIC - Logical, Intent( IN ) :: ABFLUX - Logical, Intent( IN ) :: HGBIDI - -C File variables: - Real, Pointer :: MSFX2 ( :,: ) - Real, Pointer :: SOILCAT ( :,: ) - Real, Pointer :: X3M ( : ) - -C Local variables: - Character( 16 ) :: PNAME = 'INIT_MET' - Character( 16 ) :: VNAME - CHARACTER( 16 ) :: UNITSCK - CHARACTER( 30 ) :: MSG1 = ' Error interpolating variable ' - Character( 96 ) :: XMSG = ' ' - -C for INTERPX - Integer STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 - Integer V - Integer ALLOCSTAT - -C----------------------------------------------------------------------- - - LOGDEV = INIT3() - - If( MET_INITIALIZED )Return - -!> Allocate buffers - ALLOCATE ( BUFF1D( NLAYS ), - & BUFF2D( NCOLS,NROWS ), - & BUFF3D( NCOLS,NROWS,NLAYS ), STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating Buffers' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - BUFF1D = 0.0 - BUFF2D = 0.0 - BUFF3D = 0.0 - -!> Allocate shared arrays -!> Met_Data - ALLOCATE( Met_Data%RDEPVHT ( NCOLS,NROWS ), - & Met_Data%DENS1 ( NCOLS,NROWS ), - & Met_Data%PRSFC ( NCOLS,NROWS ), - & Met_Data%Q2 ( NCOLS,NROWS ), - & Met_Data%QSS_GRND ( NCOLS,NROWS ), - & Met_Data%RH ( NCOLS,NROWS ), - & Met_Data%RA ( NCOLS,NROWS ), - & Met_Data%RS ( NCOLS,NROWS ), - & Met_Data%RC ( NCOLS,NROWS ), - & Met_Data%RN ( NCOLS,NROWS ), - & Met_Data%RGRND ( NCOLS,NROWS ), - & Met_Data%HFX ( NCOLS,NROWS ), - & Met_Data%LH ( NCOLS,NROWS ), - & Met_Data%SNOCOV ( NCOLS,NROWS ), - & Met_Data%TEMP2 ( NCOLS,NROWS ), - & Met_Data%TEMPG ( NCOLS,NROWS ), - & Met_Data%TSEASFC ( NCOLS,NROWS ), - & Met_Data%USTAR ( NCOLS,NROWS ), - & Met_Data%VEG ( NCOLS,NROWS ), - & Met_Data%LAI ( NCOLS,NROWS ), - & Met_Data%WR ( NCOLS,NROWS ), - & Met_Data%WSPD10 ( NCOLS,NROWS ), - & Met_Data%WSTAR ( NCOLS,NROWS ), - & Met_Data%Z0 ( NCOLS,NROWS ), - & Met_Data%SOIM1 ( NCOLS,NROWS ), - & Met_Data%SOIT1 ( NCOLS,NROWS ), - & Met_Data%SEAICE ( NCOLS,NROWS ), - & Met_Data%MOL ( NCOLS,NROWS ), - & Met_Data%MOLI ( NCOLS,NROWS ), - & Met_Data%HOL ( NCOLS,NROWS ), - & Met_Data%XPBL ( NCOLS,NROWS ), - & Met_Data%LPBL ( NCOLS,NROWS ), - & Met_Data%CONVCT ( NCOLS,NROWS ), - & Met_Data%PBL ( NCOLS,NROWS ), - & Met_Data%NACL_EMIS( NCOLS,NROWS ), - & Met_Data%UWIND ( NCOLS+1,NROWS+1,NLAYS ), - & Met_Data%VWIND ( NCOLS+1,NROWS+1,NLAYS ), - & Met_Data%KZMIN ( NCOLS,NROWS,NLAYS ), - & Met_Data%PRES ( NCOLS,NROWS,NLAYS ), - & Met_Data%QV ( NCOLS,NROWS,NLAYS ), - & Met_Data%QC ( NCOLS,NROWS,NLAYS ), - & Met_Data%THETAV ( NCOLS,NROWS,NLAYS ), - & Met_Data%TA ( NCOLS,NROWS,NLAYS ), - & Met_Data%ZH ( NCOLS,NROWS,NLAYS ), - & Met_Data%ZF ( NCOLS,NROWS,NLAYS ), - & Met_Data%DZF ( NCOLS,NROWS,NLAYS ), - & Met_Data%DENS ( NCOLS,NROWS,NLAYS ), - & Met_Data%RJACM ( NCOLS,NROWS,NLAYS ), - & Met_Data%RJACF ( NCOLS,NROWS,NLAYS ), - & Met_Data%RRHOJ ( NCOLS,NROWS,NLAYS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating met vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - ALLOCATE( Grid_Data%DX3F ( NLAYS ), - & Grid_Data%RDX3F ( NLAYS ), - & Grid_Data%RDX3M ( NLAYS ), - & Grid_Data%RMSFX4 ( NCOLS,NROWS ), - & Grid_Data%LON ( NCOLS,NROWS ), - & Grid_Data%LAT ( NCOLS,NROWS ), - & Grid_Data%LWMASK ( NCOLS,NROWS ), - & Grid_Data%OCEAN ( NCOLS,NROWS ), - & Grid_Data%SZONE ( NCOLS,NROWS ), - & Grid_Data%PURB ( NCOLS,NROWS ), - & Grid_Data%SLTYP ( NCOLS,NROWS ), - & Grid_Data%NAME ( n_lufrac ), - & Grid_Data%LU_Type ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating grid vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Grid_Data%NAME = name_lu - Grid_Data%LU_Type = cat_lu - - If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then - ALLOCATE( Met_Data%SOIM2 ( NCOLS,NROWS ), - & Met_Data%SOIT2 ( NCOLS,NROWS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic met vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - ALLOCATE( Grid_Data%WSAT ( NCOLS,NROWS ), - & Grid_Data%WWLT ( NCOLS,NROWS ), - & Grid_Data%BSLP ( NCOLS,NROWS ), - & Grid_Data%WRES ( NCOLS,NROWS ), - & Grid_Data%WFC ( NCOLS,NROWS ), - & Grid_Data%LUFRAC ( NCOLS,NROWS,n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic grid vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Grid_Data%WSAT = 0.0 - Grid_Data%WWLT = 0.0 - Grid_Data%WFC = 0.0 - Grid_Data%WRES = 0.0 - Grid_Data%BSLP = 0.0 - - ALLOCATE( Mosaic_Data%USTAR ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%LAI ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%DELTA ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%VEG ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%Z0 ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RA ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RSTW ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%RINC ( NCOLS,NROWS,n_lufrac ), - & Mosaic_Data%NAME ( n_lufrac ), - & Mosaic_Data%LU_Type ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating mosaic vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Mosaic_Data%USTAR = 0.0 - Mosaic_Data%LAI = 0.0 - Mosaic_Data%DELTA = 0.0 - Mosaic_Data%VEG = 0.0 - Mosaic_Data%Z0 = 0.000001 - Mosaic_Data%RSTW = 0.0 - Mosaic_Data%RINC = 0.0 - Mosaic_Data%NAME = name_lu - Mosaic_Data%LU_Type = cat_lu - - ALLOCATE( ChemMos_Data%Rb ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rst ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rcut ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rgc ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rgb ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Rwat ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%CZ0 ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Cleaf ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Cstom ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Ccut ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%Csoil ( NCOLS,NROWS,n_lufrac,ltotg ), - & ChemMos_Data%NAME ( n_lufrac ), - & ChemMos_Data%LU_Type ( n_lufrac ), - & ChemMos_Data%Subname ( n_lufrac ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating chemistry dependent mosaic vars' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - ChemMos_Data%Rb = resist_max - ChemMos_Data%Rst = resist_max - ChemMos_Data%Rcut = resist_max - ChemMos_Data%Rgc = resist_max - ChemMos_Data%Rgb = resist_max - ChemMos_Data%Rwat = resist_max - ChemMos_Data%CZ0 = 0.0 - ChemMos_Data%Cleaf = 0.0 - ChemMos_Data%Cstom = 0.0 - ChemMos_Data%Ccut = 0.0 - ChemMos_Data%Csoil = 0.0 - ChemMos_Data%NAME = name_lu - ChemMos_Data%LU_Type = cat_lu - ChemMos_Data%SubName = subname - End If - -!> ccccccccccccccccccccc Fengsha option!ccccccccccccccccccccc - FENGSHA = ENVYN( 'CTM_FENGSHA', - & 'Flag for in-line fengsha ', - & .FALSE., IOSX ) - - If ( FENGSHA ) Then - ALLOCATE( Met_Data%CLAYF ( NCOLS,NROWS ), - & Met_Data%SANDF ( NCOLS,NROWS ), - & Met_Data%DRAG ( NCOLS,NROWS ), - & Met_Data%UTHR ( NCOLS,NROWS ), - & STAT = ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Then - XMSG = 'Failure allocating Fengsha variables' - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - -!> ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc - - If ( .Not. desc3( met_cro_2d ) ) Then - xmsg = 'Could not get ' // MET_CRO_2D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) rinv = .FALSE. ! Ra and Rst are in units s/m - - SPC = INDEX1( 'WR', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifwr = .True. ! canopy wetness is in METCRO2D - - SPC = INDEX1( 'Q2', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifq2 = .True. ! two meter mixing ratio in METCRO2D - - SPC = INDEX1( 'TSEASFC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) ifsst = .True. ! two meter SST in METCRO2D - - SPC = INDEX1( 'LH', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) iflh = .True. ! LH in METCRO2D - - SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_rc = 'RCA' - Else - vname_rc = 'RC' - End If - - SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_rn = 'RNA' - Else - vname_rn = 'RN' - End If - - If ( .Not. desc3( met_dot_3d ) ) Then - xmsg = 'Could not get ' // MET_DOT_3D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - SPC = INDEX1( 'UWINDC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_uc = 'UWINDC' - CSTAGUV = .TRUE. - Else - vname_uc = 'UWIND' - CSTAGUV = .FALSE. - End If - - SPC = INDEX1( 'VWINDC', NVARS3D, VNAME3D ) - If (SPC .Gt. 0) Then - vname_vc = 'VWINDC' - Else - vname_vc = 'VWIND' - End If - - If ( .Not. desc3( met_cro_3d ) ) Then - xmsg = 'Could not get ' // MET_CRO_3D // ' file description' - Call m3exit( pname, JDATE, JTIME, xmsg, xstat2 ) - End If - - V = INDEX1( 'PRES', NVARS3D, VNAME3D ) - If ( V .Ne. 0 ) Then - UNITSCK = UNITS3D( V ) - Else - XMSG = 'Could not get variable PRES from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Select Case (UNITSCK) - Case ( 'PASCAL','pascal','Pascal','PA','pa','Pa' ) - CONVPA = 1.0 - P0 = 100000.0 - Case ( 'MILLIBAR','millibar','Millibar','MB','mb','Mb' ) - CONVPA = 1.0E-02 - P0 = 100000.0 * CONVPA - Case ( 'CENTIBAR','centibar','Centibar','CB','cb','Cb' ) - CONVPA = 1.0E-03 - P0 = 100000.0 * CONVPA - Case Default - XMSG = 'Units incorrect on ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End Select - - MINKZ = .True. ! default - MINKZ = ENVYN( 'KZMIN', 'Kz min on flag', MINKZ, ALLOCSTAT ) - If ( ALLOCSTAT .Ne. 0 ) Write( LOGDEV,'(5X, A)' ) 'Kz min on flag' - Select Case( ALLOCSTAT ) - Case ( 1 ) - XMSG = 'Environment variable improperly formatted' - Call M3WARN( PNAME, JDATE, JTIME, XMSG ) - Case ( -1 ) - XMSG = 'Environment variable set, but empty ... Using default:' - Write( LOGDEV,'(5X, A)' ) XMSG - Case ( -2 ) - XMSG = 'Environment variable not set ... Using default:' - Write( LOGDEV,'(5X, A)' ) XMSG - End Select - - If ( .Not. MINKZ ) Then - XMSG = 'This run uses Kz0UT, *NOT* KZMIN in subroutine edyintb.' - Write( LOGDEV,'(/5X, A, /)' ) XMSG - End If - -!> Open the met files - - Call SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, - & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) - Call SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, - & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) - Call SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, - & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) - Call SUBHFILE ( MET_DOT_3D, GXOFF, GYOFF, - & STRTCOLMD3, ENDCOLMD3, STRTROWMD3, ENDROWMD3 ) - CALL SUBHFILE ( OCEAN_1, GXOFF, GYOFF, - & STRTCOL_O1, ENDCOL_O1, STRTROW_O1, ENDROW_O1 ) -!> Get sigma coordinate variables - X3M => BUFF1D - Do L = 1, NLAYS - Grid_Data%DX3F( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) - Grid_Data%RDX3F( L ) = 1.0 / Grid_Data%DX3F( L ) - X3M( L ) = 0.5 * ( X3FACE_GD( L ) + X3FACE_GD( L-1 ) ) - End Do - Do L = 1, NLAYS - 1 - Grid_Data%RDX3M( L ) = 1.0 / ( X3M( L+1 ) - X3M( L ) ) - End Do - Grid_Data%RDX3M( NLAYS ) = 0.0 -!> nullify pointer - Nullify( X3M ) - -!> reciprical of msfx2**2 -!> assign MSFX2 - MSFX2 => BUFF2D - VNAME = 'MSFX2' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, MSFX2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Grid_Data%RMSFX4 = 1.0 / ( MSFX2**2 ) -!> nullify pointer - Nullify( MSFX2 ) - - VNAME = 'LON' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LON ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'LAT' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LAT ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'LWMASK' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LWMASK ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'PURB' - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%PURB ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - SOILCAT => BUFF2D - VNAME = 'SLTYP' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, SOILCAT ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Grid_Data%SLTYP = NINT( SOILCAT ) - Nullify( SOILCAT ) - - If ( ABFLUX .Or. MOSAIC ) Then - Do l = 1, n_lufrac - Write( vname,'( "LUFRAC_",I2.2 )' ) l - If ( .Not. INTERPX( GRID_CRO_2D, VNAME, PNAME, - & STRTCOLGC2,ENDCOLGC2, STRTROWGC2,ENDROWGC2, 1,1, - & JDATE, JTIME, Grid_Data%LUFRAC( :,:,l ) ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // GRID_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End Do - - Forall( C = 1:MY_NCOLS, R = 1:MY_NROWS, Grid_Data%SLTYP(C,R) .Le. 11 ) - Grid_Data%WSAT( C,R ) = WSAT( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WWLT( C,R ) = WWLT( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WFC ( C,R ) = WFC ( Grid_Data%SLTYP( C,R ) ) - Grid_Data%WRES( C,R ) = WRES( Grid_Data%SLTYP( C,R ) ) - Grid_Data%BSLP( C,R ) = BSLP( Grid_Data%SLTYP( C,R ) ) - End Forall - End If - -!> Read fractional seawater and surf-zone coverage from the OCEAN file. -!> Store results in the OCEAN and SZONE arrays. - IF ( .NOT. OPEN3( OCEAN_1, FSREAD3, PNAME ) ) THEN - XMSG = 'Open failure for ' // OCEAN_1 - CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'OPEN' - If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, - & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, - & 1,1,JDATE, JTIME, Grid_Data%OCEAN ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SURF' - If ( .Not. INTERPX( OCEAN_1, VNAME, PNAME, - & STRTCOL_O1,ENDCOL_O1, STRTROW_O1,ENDROW_O1, - & 1,1,JDATE, JTIME, Grid_Data%SZONE ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // OCEAN_1 - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - MET_INITIALIZED = .true. - - Return - End Subroutine INIT_MET - -C======================================================================= - Subroutine GET_MET ( JDATE, JTIME, TSTEP, MOSAIC, ABFLUX, HGBIDI ) - -C----------------------------------------------------------------------- -C 30 Mar 01 J.Young: dyn alloc - Use HGRD_DEFN; replace INTERP3 with INTERPX; -C allocatable RDEPVHT, RJACM, RRHOJ -C 14 Nov 03 J.Young: add reciprocal vertical Jacobian product for full and -C mid-layer -C Tanya took JACOBF out of METCRO3D! Improvise -C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical -C domain specifications in one module -C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN -C----------------------------------------------------------------------- - - USE GRID_CONF ! horizontal & vertical domain specifications - Use UTILIO_DEFN -#ifdef parallel - USE SE_MODULES ! stenex (using SE_COMM_MODULE) -#else - USE NOOP_MODULES ! stenex (using NOOP_COMM_MODULE) -#endif - - Implicit None - - Include SUBST_FILES_ID ! file name parameters - Include SUBST_PE_COMM ! PE communication displacement and direction - Include SUBST_CONST ! constants - -C Arguments: - - Integer, Intent( IN ) :: JDATE, JTIME, TSTEP ! internal simulation date&time - Logical, Intent( IN ) :: MOSAIC - Logical, Intent( IN ) :: ABFLUX - Logical, Intent( IN ) :: HGBIDI - -C Parameters: - Real, Parameter :: cond_min = 1.0 / resist_max ! minimum conductance [m/s] - Real, Parameter :: KZMAXL = 500.0 ! upper limit for min Kz [m] - Real, Parameter :: KZ0UT = 1.0 ! minimum eddy diffusivity [m**2/sec] KZ0 - Real, Parameter :: KZL = 0.01 ! lowest KZ - Real, Parameter :: KZU = 1.0 ! 2.0 ! highest KZ - Real, Parameter :: EPS = 1.0E-08 ! small number for temperature difference - -C Local variables: - Real FINT - Real CPAIR, LV, QST - Real TMPFX, TMPVTCON, TST, TSTV - Real, Pointer :: Es_Grnd ( :,: ) - Real, Pointer :: Es_Air ( :,: ) - Real, Pointer :: TV ( :,:,: ) - Integer LP - Integer C, R, L ! loop induction variables - - Character( 16 ) :: PNAME = 'GET_MET' - Character( 16 ) :: VNAME - CharactER( 30 ) :: MSG1 = ' Error interpolating variable ' - Character( 96 ) :: XMSG = ' ' - -C----------------------------------------------------------------------- -C Interpolate file input variables and format for output -C-------------------------------- MET_CRO_3D -------------------------------- - - VNAME = 'ZH' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%ZH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'PRES' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%PRES ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'ZF' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%ZF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'DENS' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%DENS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - - Met_Data%DENS1 = Met_Data%DENS( :,:,1 ) - - VNAME = 'JACOBM' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RJACM ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RJACM = 1.0 / Met_Data%RJACM - - VNAME = 'JACOBF' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RJACF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RJACF = 1.0 / Met_Data%RJACF - - VNAME = 'DENSA_J' - If ( .Not. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%RRHOJ ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Met_Data%RRHOJ = 1.0 / Met_Data%RRHOJ - - VNAME = 'TA' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%TA ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'QV' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%QV ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - - VNAME = 'QC' - IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, - & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, - & JDATE, JTIME, Met_Data%QC ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_3D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - -C-------------------------------- MET_CRO_2D -------------------------------- -C Vegetation and surface vars - VNAME = 'LAI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LAI ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'VEG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%VEG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'ZRUF' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%Z0 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If -C FENGSHA vars - If ( FENGSHA ) Then - write(*,*) 'Read clayfrac' - VNAME = 'CLAYF' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%CLAYF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - write(*,*) 'read sandfrac' - VNAME = 'SANDF' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%SANDF ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'DRAG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%DRAG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'UTHR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2,1,1, - & JDATE, JTIME, Met_Data%UTHR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If -C Soil vars - VNAME = 'SOIM1' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIM1 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( ABFLUX .Or. HGBIDI .Or. MOSAIC ) Then - VNAME = 'SOIM2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIM2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SOIT2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIT2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - VNAME = 'SOIT1' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SOIT1 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SEAICE' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SEAICE ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - -C met vars - - VNAME = 'PRSFC' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%PRSFC ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'RGRND' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RGRND ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'SNOCOV' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%SNOCOV ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Where( Met_Data%SNOCOV .Lt. 0.0 ) - Met_Data%SNOCOV = 0.0 - End Where - - VNAME = 'TEMP2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TEMP2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'TEMPG' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TEMPG ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'USTAR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%USTAR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'WSPD10' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%WSPD10 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'HFX' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%HFX ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( iflh ) Then - VNAME = 'LH' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else ! for backward compatibility - VNAME = 'QFX' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%LH ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - VNAME = 'PBL' - IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%PBL ) ) THEN - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - END IF - -C Met_cro_2D variables that have recently changed due to MCIP or WRF/CMAQ - - If ( .Not. INTERPX( MET_CRO_2D, vname_rn, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RN ) ) Then - XMSG = MSG1 // TRIM( vname_rn ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( .Not. INTERPX( MET_CRO_2D, vname_rc, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RC ) ) Then - XMSG = MSG1 // TRIM( vname_rc ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - If ( ifwr ) Then - VNAME = 'WR' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%WR ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - End If - - If ( ifsst ) Then - VNAME = 'TSEASFC' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%TSEASFC ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else - Met_Data%TSEASFC = Met_Data%TEMPG - End If - - If ( rinv ) Then - VNAME = 'RADYNI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RA ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Where( Met_Data%RA .Gt. cond_min ) - Met_Data%RA = 1.0/Met_Data%RA - Elsewhere - Met_Data%RA = resist_max - End Where - - VNAME = 'RSTOMI' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - Where( Met_Data%RS .Gt. cond_min ) - Met_Data%RS = 1.0 / Met_Data%RS - Elsewhere - Met_Data%RS = resist_max - End Where - - Else - - VNAME = 'RA' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RA ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - VNAME = 'RS' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%RS ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - - End If - - If ( ifq2 ) Then ! Q2 in METCRO2D - VNAME = 'Q2' - If ( .Not. INTERPX( MET_CRO_2D, VNAME, PNAME, - & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, - & JDATE, JTIME, Met_Data%Q2 ) ) Then - XMSG = MSG1 // TRIM( VNAME ) // ' from ' // MET_CRO_2D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) - End If - Else - Met_Data%Q2 = Met_Data%QV( :,:,1 ) - End If - - Es_Grnd => BUFF2D - Where( Met_Data%TEMPG .Lt. stdtemp ) - Es_Grnd = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMPG ) ) - Elsewhere - Es_Grnd = vp0 *Exp( svp2 * ( Met_Data%TEMPG -stdtemp ) / ( Met_Data%TEMPG -svp3 ) ) - End Where - Met_Data%QSS_GRND = Es_Grnd * 0.622 / ( Met_Data%PRSFC - Es_Grnd ) - Nullify( Es_Grnd ) - - Es_Air => BUFF2D - Where( Met_Data%TEMP2 .Lt. stdtemp ) - Es_Air = vp0 *Exp( 22.514 - ( 6.15e3 / Met_Data%TEMP2 ) ) - Elsewhere - Es_Air = vp0 *Exp( svp2 * ( Met_Data%TEMP2 -stdtemp ) / ( Met_Data%TEMP2 -svp3 ) ) - End Where - Met_Data%RH = Met_Data%Q2 / ( Es_Air * 0.622 / ( Met_Data%PRSFC - Es_Air ) ) * 100.0 - Where( Met_Data%RH .Gt. 100.0 ) - Met_Data%RH = 100.0 - Elsewhere( Met_Data%RH .lt. 0.0 ) - Met_Data%RH = 0.0 - End Where - Nullify( Es_Air ) - -C-------------------------------- MET_DOT_3D -------------------------------- - If ( .Not. INTERPX( MET_DOT_3D, vname_uc, PNAME, - & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, - & JDATE, JTIME, Met_Data%UWIND ) ) Then - XMSG = MSG1 // TRIM( vname_uc ) // ' from ' // MET_DOT_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - - If ( .Not. INTERPX( MET_DOT_3D, vname_vc, PNAME, - & STRTCOLMD3,ENDCOLMD3, STRTROWMD3,ENDROWMD3, 1,NLAYS, - & JDATE, JTIME, Met_Data%VWIND ) ) Then - XMSG = MSG1 // TRIM( vname_vc ) // ' from ' // MET_DOT_3D - Call M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT 1 ) - End If - -C get ghost values for wind fields in case of free trop. - CALL SUBST_COMM ( Met_Data%UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) - CALL SUBST_COMM ( Met_Data%VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) - -C-------------------------------- Calculated Variables -------------------------------- - Met_Data%DZF = Met_Data%ZF - EOSHIFT(Met_Data%ZF, Shift = -1, Boundary = 0.0, Dim = 3) - - Met_Data%RDEPVHT = 1.0 / Met_Data%ZF( :,:,1 ) - - IF ( MINKZ ) THEN - Met_Data%KZMIN = KZL - DO L = 1, NLAYS - Where( Met_Data%ZF( :,:,L ) .LE. KZMAXL ) - Met_Data%KZMIN( :,:,L ) = KZL + ( KZU - KZL ) * 0.01 * Grid_data%PURB - End Where - End Do - ELSE - Met_Data%KZMIN = KZ0UT - END IF - - TV => BUFF3D - TV = Met_Data%TA * ( 1.0 + 0.608 * Met_Data%QV ) - Met_Data%THETAV = TV * ( P0 / Met_Data%PRES ) ** 0.286 - Nullify( TV ) - -C------ Updating MOL, then WSTAR, MOLI, HOL - DO R = 1, MY_NROWS - DO C = 1, MY_NCOLS - ! CPAIR = 1004.67 * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) - CPAIR = CPD * ( 1.0 + 0.84 * Met_Data%QV( C,R,1 ) ) ! J/(K KG) - TMPFX = Met_Data%HFX( C,R ) / ( CPAIR * Met_Data%DENS( C,R,1 ) ) - TMPVTCON = 1.0 + 0.608 * Met_Data%QV( C,R,1 ) ! Conversion factor for virtual temperature - TST = -TMPFX / Met_Data%USTAR( C,R ) - IF ( Met_Data%TA( C,R,1 ) .GT. STDTEMP ) THEN - LV = LV0 - ( 0.00237 * ( Met_Data%TA( C,R,1 ) - STDTEMP ) ) * 1.0E6 - ELSE - LV = 2.83E6 ! Latent heat of sublimation at 0C from Stull (1988) (J/KG) - END IF - QST = -( Met_Data%LH( C,R ) / LV ) - & / ( Met_Data%USTAR( C,R ) * Met_Data%DENS( C,R,1 ) ) - TSTV = TST * TMPVTCON + Met_Data%THETAV( C,R,1 ) * 0.608 * QST - IF ( ABS( TSTV ) .LT. 1.0E-6 ) THEN - TSTV = SIGN( 1.0E-6, TSTV ) - END IF - Met_Data%MOL( C,R ) = Met_Data%THETAV( C,R,1 ) - & * Met_Data%USTAR( C,R ) ** 2 / ( karman * GRAV * TSTV ) - IF ( Met_Data%MOL( C,R ) .LT. 0.0 ) THEN - Met_Data%WSTAR( C,R ) = Met_Data%USTAR( C,R ) * ( Met_Data%PBL( C,R ) - & / ( karman * ABS( Met_Data%MOL( C,R ) ) ) ) ** 0.333333 - ELSE - Met_Data%WSTAR( C,R ) = 0.0 - END IF - - END DO - END DO - - Met_Data%MOLI = 1.0 / Met_Data%MOL - Met_Data%HOL = Met_Data%PBL / Met_Data%MOL -C------ - - Met_Data%CONVCT = .FALSE. - DO R = 1, MY_NROWS - DO C = 1, MY_NCOLS - DO L = 1, NLAYS - IF ( Met_Data%PBL( C,R ) .LT. Met_Data%ZF( C,R,L ) ) THEN - LP = L; EXIT - END IF - END DO - - Met_Data%LPBL( C,R ) = LP - If ( LP .Eq. 1 ) Then - FINT = ( Met_Data%PBL( C,R ) ) - & / ( Met_Data%ZF( C,R,LP ) ) - Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) - & + X3FACE_GD( LP-1 ) - Else - FINT = ( Met_Data%PBL( C,R ) - Met_Data%ZF( C,R,LP-1 ) ) - & / ( Met_Data%ZF( C,R,LP ) - Met_Data%ZF( C,R,LP-1 ) ) - Met_Data%XPBL( C,R ) = FINT * ( X3FACE_GD( LP ) - X3FACE_GD( LP-1 ) ) - & + X3FACE_GD( LP-1 ) - End If - END DO - END DO - Where( Met_Data%THETAV( :,:,1 ) - Met_Data%THETAV( :,:,2 ) .Gt. EPS .And. - & Met_Data%HOL .Lt. -0.02 .And. Met_Data%LPBL .Gt. 3 ) - Met_Data%CONVCT = .True. - End Where - - Return - End Subroutine GET_MET - - End Module ASX_DATA_MOD diff --git a/src/model/src/DUST_EMIS.F b/src/model/src/DUST_EMIS.F deleted file mode 100644 index 3fb64c8..0000000 --- a/src/model/src/DUST_EMIS.F +++ /dev/null @@ -1,1525 +0,0 @@ - -!------------------------------------------------------------------------! -! The Community Multiscale Air Quality (CMAQ) system software is in ! -! continuous development by various groups and is based on information ! -! from these groups: Federal Government employees, contractors working ! -! within a United States Government contract, and non-Federal sources ! -! including research institutions. These groups give the Government ! -! permission to use, prepare derivative works of, and distribute copies ! -! of their work in the CMAQ system to the public and to permit others ! -! to do so. The United States Environmental Protection Agency ! -! therefore grants similar permission to use the CMAQ system software, ! -! but users are requested to provide copies of derivative works or ! -! products designed to operate in the CMAQ system to the United States ! -! Government without restrictions as to use by others. Software ! -! that is used with the CMAQ system but distributed under the GNU ! -! General Public License or the GNU Lesser General Public License is ! -! subject to their copyright restrictions. ! -!------------------------------------------------------------------------! - - -C RCS file, release, date & time of last delta, author, state, [and locker] -C $Header: /project/work/rep/arc/CCTM/src/emis/emis/DUST_EMIS.F,v 1.6 2011/10/21 16:10:45 yoj Exp $ - -C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - module dust_emis - -C----------------------------------------------------------------------- -C Description: -C * Extracts selected landuse categories from BELD01 and BELD03 and merges -C * the selections into a dust-related landuse array (ULAND). - -C Optionally, reads 3 gridded crop calendar file and calculates an -C erodible agriculture land fraction. (cropcal) - -C * Applies a predetermined removal fraction in and below canopy to -C * ULAND and determines a transport factor (TFB) for this regime. -C * = applies to tfbelow - -C Function: 3d point source emissions interface to the chemistry-transport model - -C Revision History: -C 16 Dec 10 J.Young: Adapting Daniel Tong`s work on windblown dust -C 21 Apr 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN -C 11 May 11 D.Wong: incorporated twoway model implementation -C 8 Jul 11 J.Young: unified string lengths in character lists for compiler compatibility -C 11 Nov 11 J.Young: generalizing land use/cover -C 8 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 -C 13 Jul 12 J.Young: following Daniel Tong: changed clayc, siltc, sandc units from mass -C fraction to %; adjusted F/G (vertical to horizontal flux) ratio -C to be continuous for clay content > 20% -C 30 Sep 13 J.Young: corrected diag file units description; added snow cover adjustment; -C adjusted F/G (vertical to horizontal flux) ratio to be continuous -C for clay content > 0.2; convert volumetric soil moisture to -C gravimetric water content; corrected soil moisture factor (fmoit); -C use lwmask>0 rather than sltyp>0 (non-existent) for over water test -C 15 Sep 15 H.Foroutan: revised threshold friction velocity parameterization -C 20 Oct 15 H.Foroutan: Updated the calculation of the threshold velocity(U*t), which is -C now based on dust particle size, following Shao and Lu [JGR,2000]. -C Implemented a dynamic vegetation fraction based on the MODIS FPAR. -C Introduced a new parametrization for surface roughness (z0) -C applicable to dust emission schemes, and accordingly calculated -C the friction velocity (U*) at the surface using 10m wind speed -C and the new (microspcopic) surface roughness. -C Surface roughness adjusted for estimated annual vegetation height. -C Included drag partitioning coefficient. Updated the calculation of -C the vertical-to-horizontal flux based on Lu and Shao [JGR,1999]. -C Updated the dust diag output file accordingly. -C 8 Jan 16 J.Young: Changes for computational efficiency -C 2 Feb 16 J.Young: move dust aero speciation table to AERO_DATA -C----------------------------------------------------------------------- - use lus_defn - use aero_data - - implicit none - -C windblown dust emissions rates - real, allocatable, save :: dustoutm( :,:,:,: ) ! mass emission rates [g/m**3/s] - real, allocatable, save :: dustoutn( :,:,: ) ! number emission rates [1/m**3/s] - real, allocatable, save :: dustouts( :,:,: ) ! surface-area emisrates [m2/m**3/s] - - public ndust_spc, dustoutm, dustoutn, dustouts, dust_spc, - & dust_emis_init, get_dust_emis - private - - real, allocatable, save :: dust_em( :,: ) ! total dust emissions [g/m**3/s] - -C updated values of mass fraction for "freshly emitted dust" -C based on Kok [PNAS, 2011] and Nabat et al. [ACP, 2012] - real, parameter :: fracmj = 0.07 ! mass fraction assigned to accum mode - real, parameter :: fracmk = 0.93 ! mass fraction assigned to coarse mode - -C diam`s from fracmj,fracmk-weighted 2 2-bin averages of geom means -C 2 J-mode bins: 0.1-1.0, 1.0-2.5 um -C 2 K-mode bins: 2.5-5.0, 5.0-10.0 um - real, parameter :: dgvj = 1.3914 ! geom mean diam of accum mode [um] - real, parameter :: dgvk = 5.2590 ! geom mean diam of coarse mode [um] - real, parameter :: sigj = 2.0000 ! geom std deviation of accum mode flux - real, parameter :: sigk = 2.0000 ! geom std deviation of coarse mode flux - -C Local Variables: - -C Factors for converting 3rd moment emission rates into number and 2nd moment -C emission rates. (Diameters in [um] changed to [m] ) See Equations 7b and 7c -C of Binkowski & Roselle (2003) - real :: l2sgj ! [ln( sigj )] ** 2 - real :: l2sgk ! [ln( sigk )] ** 2 - real, save :: factnumj ! = exp( 4.5 * l2sgj ) / dgvj ** 3 * 1.0e18 - real, save :: factnumk ! = exp( 4.5 * l2sgk ) / dgvk ** 3 * 1.0e18 - real, save :: factm2j ! = exp( 0.5 * l2sgj ) / dgvj * 1.0e6 - real, save :: factm2k ! = exp( 0.5 * l2sgk ) / dgvk * 1.0e6 - real, save :: factsrfj ! = pi * factm2j - real, save :: factsrfk ! = pi * factm2k - - real, save :: dustmode_dens( n_mode ) ! average modal density [kg/m**3] - real :: sumsplit, sumfrac - integer :: n, idx - -C Number of soil types: For both WRF and MM5-PX met models, there are 16 types; -C the first 12 soil types are used and the rest lumped into Other. - integer, parameter :: nsltyp = 13 - -C Variables for the windblown dust diagnostic file: - logical, save :: dustem_diag ! flag for dustemis diagnostic file - integer, parameter :: fndust_diag = 19 ! number of fixed diagnostic output vars - integer, save :: ndust_diag ! number of diagnostic output vars - real, allocatable, save :: diagv( : ) ! diagnostic output variables - real, allocatable, save :: dustbf( :,:,: ) ! diagnostic accumulate buffer - -#ifdef verbose_wbdust - real, allocatable, save :: sdiagv( : ) ! global sum of each diag output var -#endif - - type diag_type - character( 16 ) :: var - character( 16 ) :: units - character( 80 ) :: desc - end type diag_type - - type( diag_type ), allocatable, save :: diagnm( : ) - type( diag_type ), allocatable, save :: vdiagnm_emis( : ) - type( diag_type ), allocatable, save :: vdiagnm_frac( : ) - type( diag_type ), allocatable, save :: vdiagnm_ustar( : ) - type( diag_type ), allocatable, save :: vdiagnm_kvh( : ) - type( diag_type ), allocatable, save :: vdiagnm_rough( : ) - - character( 10 ) :: truncnm - character( 16 ) :: vnm - - type( diag_type ), parameter :: fdiagnm( fndust_diag ) = (/ -C var units desc -C ---------------- -------- ------------------------------------------- - & diag_type( 'Cropland_Emis ', 'g/m**3/s', 'emissions for cropland landuse type '), - & diag_type( 'Desertland_Emis ', 'g/m**3/s', 'total emis for desert types and cropland '), - & diag_type( 'Cropland_Frac ', 'percent ', 'cropland erodible landuse fraction (%) '), - & diag_type( 'Desertland_Frac ', 'percent ', 'total desert fraction (%) '), - & diag_type( 'Cropland_Ustar ', 'm/s ', 'u* for cropland '), - & diag_type( 'Cropland_kvh ', '1/m ', 'cropland vert to horiz flux ratio '), - & diag_type( 'Cropland_Rough ', ' ', 'cropland surface roughness factor '), - & diag_type( 'Soil_Moist_Fac ', ' ', 'soil moisture factor for threshold u* '), - & diag_type( 'Soil_Erode_Pot ', ' ', 'soil -> dust erodiblity potential '), - & diag_type( 'Mx_Adsrb_H2O_Frc', ' ', 'max adsorbed water fraction '), - & diag_type( 'Vegetation_Frac ', ' ', 'vegetation land coverage '), - & diag_type( 'Urban_Cover ', 'percent ', 'urban land coverage '), - & diag_type( 'Forest_Cover ', 'percent ', 'forest land coverage '), - & diag_type( 'Trfac_Above_Can ', ' ', 'transport factor above canopy '), - & diag_type( 'Trfac_Inside_Can', ' ', 'transport factor in and below canopy '), - & diag_type( 'ANUMJ ', '#/s ', 'accumulation mode number '), - & diag_type( 'ANUMK ', '#/s ', 'coarse mode number '), - & diag_type( 'ASRFJ ', 'm**2/s ', 'accumulation mode surface area '), - & diag_type( 'ASRFK ', 'm**2/s ', 'coarse mode surface area ')/) - -C Module shared variables: - real, allocatable, save :: agland( :,: ) ! agriculture land fraction - real, allocatable, save :: wmax ( :,: ) ! max adsorb water percent - real, allocatable, save :: kvh ( :,:,: ) ! ratio of vertical flux / horizontal (k factor) - real, allocatable, save :: sd_ep ( :,: ) ! soil->dust erodiblity potential - real, allocatable, save :: tfb ( :,: ) ! transport fraction in and below canopy - real, allocatable, save :: fpar ( :,: ) ! modis fpar - - integer, save :: sdate, stime ! scenario start date & time - - real :: eropot( 3 ) = ! erodible potential of soil components - & (/ 0.08, ! clay - & 1.00, ! silt - & 0.12 /) ! sand - - integer, save :: logdev - - CONTAINS - -C======================================================================= - function dust_emis_init( jdate, jtime, tstep ) result( success ) - -C Revision History. -C Aug 12, 15 D. Wong: Replaced MYPE with IO_PE_INCLUSIVE for parallel I/O -C implementation - - use hgrd_defn ! horizontal domain specifications - use aero_data ! aerosol species definitions - use asx_data_mod ! meteorology data - use utilio_defn - -C Arguments: - integer, intent( in ) :: jdate ! current model date, coded YYYYDDD - integer, intent( in ) :: jtime ! current model time, coded HHMMSS - integer, intent( in ) :: tstep ! output time step - logical success - -C Includes: - include SUBST_FILES_ID ! file name parameters - -C External Functions: - integer, external :: setup_logdev - -C Local variables: - character( 16 ) :: ctm_dustem_diag = 'CTM_DUSTEM_DIAG' ! env var for - ! diagnostic file - character( 16 ) :: ctm_erode_agland = 'CTM_ERODE_AGLAND' ! env var to - ! use erodible cropland - character( 16 ) :: pname = 'DUST_EMIS_INIT' - character( 16 ) :: vname - character( 80 ) :: vardesc - character( 120 ) :: xmsg = ' ' - character( 16 ) :: modis_fpar_1 = 'MODIS_FPAR' - ! Fraction of Absorbed Photosynthetically Active Radiation - - logical :: erode_agland = .true. ! default - integer status - integer c, r, i, j, k, l, n - integer idiag - integer n_mass_emissions - - integer gxoff, gyoff ! global origin offset from file - integer, save :: strtcol, endcol, strtrow, endrow - integer jdatemod - - type( diag_type ), allocatable :: diagnm_swap( : ) - - interface - subroutine cropcal ( jdate, jtime, agland ) - integer, intent( in ) :: jdate, jtime - real, intent( out ) :: agland( :,: ) - end subroutine cropcal - subroutine tfbelow ( jdate, jtime, tfb ) - integer, intent( in ) :: jdate, jtime - real, intent( out ) :: tfb( :,: ) - end subroutine tfbelow - end interface - -C----------------------------------------------------------------------- - - logdev = setup_logdev() - success = .true. - - - allocate ( dustoutm( ndust_spc,n_mode,ncols,nrows ), - & dustoutn( n_mode,ncols,nrows ), - & dustouts( n_mode,ncols,nrows ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating DUSTOUTM, DUSTOUTN, or DUSTOUTS' - call m3warn ( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - -C Allocate emissions array - allocate( dust_em( ncols,nrows ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating DUST_EM' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - -C Allocate private arrays - allocate( agland( ncols,nrows ), - & wmax ( ncols,nrows ), - & sd_ep ( ncols,nrows ), - & fpar ( ncols,nrows ), - & tfb ( ncols,nrows ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating AGLAND, WMAX, FPAR, SD_EP, or TFB' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - agland = 0.0 ! array assignment - wmax = 0.0 ! array assignment - sd_ep = 0.0 ! array assignment - fpar = 0.0 ! array assignment - -C Open MODIS file to get vegetation fraction - if ( .not. open3( modis_fpar_1, fsread3, pname ) ) then - xmsg = 'Could not open ' // modis_fpar_1 - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - -C Get the file description - if ( .not. desc3( modis_fpar_1 ) ) then - xmsg = 'Could not get ' - & // trim( modis_fpar_1 ) - & // ' file description' - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - -C To be able to use either climatological (2001-2010 averaged) or -C current fpar value. The year for the climatological fpar is 2005 in -C the input file. - if ( sdate3d .eq. 2005001 ) then ! climatological - jdatemod = 2005000 + mod( jdate,1000 ) - else ! current - jdatemod = jdate - end if - -C Get domain decomp info - call subhfile ( modis_fpar_1, gxoff, gyoff, - & strtcol, endcol, strtrow, endrow ) - -C Read in FPAR from MODIS file - xmsg = 'Could not read FPAR from ' // trim( modis_fpar_1 ) - if ( .not. xtract3( modis_fpar_1, 'MODIS_FPAR_T', 1,1, - & strtrow,endrow,strtcol,endcol, - & jdatemod, jtime, fpar( 1,1 ) ) ) - & call m3exit ( pname, jdate, jtime, xmsg, xstat1 ) - -C Initialize land use/cover variables - if ( .not. lus_init( jdate, jtime ) ) then - xmsg = 'Failure initializing land use module' - call m3exit( pname, jdate, jtime, xmsg, xstat2 ) - end if - -C Get env var for diagnostic output - dustem_diag = .false. ! default - vardesc = 'Flag for writing the windblown dust emission diagnostic file' - dustem_diag = envyn( ctm_dustem_diag, vardesc, dustem_diag, status ) - if ( status .ne. 0 ) write( logdev,'( 5x, a )' ) vardesc - if ( status .eq. 1 ) then - xmsg = 'Environment variable improperly formatted' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - else if ( status .eq. -1 ) then - xmsg = 'Environment variable set, but empty ... Using default:' - write( logdev,'( 5x, a, i9 )' ) xmsg, jtime - else if ( status .eq. -2 ) then - xmsg = 'Environment variable not set ... Using default:' - write( logdev,'( 5x, a, i9 )' ) xmsg, jtime - end if - - if ( dustem_diag ) then ! Open the emissions diagnostic file - -C Set up variable diagnostic names (from LUS_DEFN) - allocate( vdiagnm_emis ( n_dlcat ), - & vdiagnm_frac ( n_dlcat ), - & vdiagnm_kvh ( n_dlcat ), - & vdiagnm_rough( n_dlcat ), - & vdiagnm_ustar( n_dlcat ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating VDIAGNM_*' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - vdiagnm_emis = diag_type( ' ', ' ', ' ' ) ! array assignment - vdiagnm_frac = diag_type( ' ', ' ', ' ' ) ! array assignment - vdiagnm_ustar = diag_type( ' ', ' ', ' ' ) ! array assignment - vdiagnm_kvh = diag_type( ' ', ' ', ' ' ) ! array assignment - vdiagnm_rough = diag_type( ' ', ' ', ' ' ) ! array assignment - -C...Count the number of mass emissions species - n_mass_emissions = 0 - do i = 1, ndust_spc - do j = 1, n_mode - if( len_trim( dust_spc( i )%name( j ) ) .lt. 1 )cycle - n_mass_emissions = n_mass_emissions + 1 - end do - end do - - ndust_diag = fndust_diag + 5 * n_dlcat + n_mass_emissions - - do i = 1, n_dlcat - truncnm = vnmld( i )%desc ! char( 10 ) -C... replace embedded spaces (within 16 chars) with "_" -C... replace embedded dashes (within 16 chars) with "_" - l = len_trim( truncnm ) - do k = 1, l - if ( truncnm( k:k ) .eq. " " .or. - & truncnm( k:k ) .eq. "-" ) truncnm( k:k ) = "_" - end do - vnm = trim( truncnm ) // '_Emis' ! char( 16 ) - vdiagnm_emis( i ) = diag_type( vnm, 'g/m**2/s', vnmld( i )%desc ) - vnm = trim( truncnm ) // '_Frac' ! char( 16 ) - vdiagnm_frac( i ) = diag_type( vnm, 'percent', vnmld( i )%desc ) - vnm = trim( truncnm ) // '_Ustr' ! char( 16 ) - vdiagnm_ustar( i ) = diag_type( vnm, 'm/s', vnmld( i )%desc ) - vnm = trim( truncnm ) // '_Kvh' ! char( 16 ) - vdiagnm_kvh( i ) = diag_type( vnm, '1/m', vnmld( i )%desc ) - vnm = trim( truncnm ) // '_Rough' ! char( 16 ) - vdiagnm_rough( i ) = diag_type( vnm, ' ', vnmld( i )%desc ) - end do - -C Allocate diagnostic emissions arrays - allocate( diagnm( ndust_diag ), ! diag_type - & diagv ( ndust_diag ), - & dustbf( ndust_diag,ncols,nrows ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating DIAGNM, DIAGV or DUSTBF' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - -#ifdef verbose_wbdust - allocate( sdiagv( ndust_diag ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating SDIAGV' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if -#endif - -C Build the complete diagnostic name array n for MODIS NOAH - do i = 1, n_dlcat ! 4 - diagnm( i ) = vdiagnm_emis( i ) - end do - n = n_dlcat + 1 - diagnm( n ) = fdiagnm( 1 ) ! Cropland_Emis - n = n + 1 - diagnm( n ) = fdiagnm( 2 ) ! Desertland_Emis - - do i = 1, n_dlcat - diagnm( i+n ) = vdiagnm_frac( i ) - end do - n = n + n_dlcat + 1 - diagnm( n ) = fdiagnm( 3 ) ! Cropland_Frac - n = n + 1 - diagnm( n ) = fdiagnm( 4 ) ! Desertland_Frac - - do i = 1, n_dlcat - diagnm( i+n ) = vdiagnm_ustar( i ) - end do - n = n + n_dlcat + 1 - diagnm( n ) = fdiagnm( 5 ) ! Cropland_Ustar - - do i = 1, n_dlcat - diagnm( i+n ) = vdiagnm_kvh( i ) - end do - n = n + n_dlcat + 1 - diagnm( n ) = fdiagnm( 6 ) ! Cropland_Kvh - - do i = 1, n_dlcat - diagnm( i+n ) = vdiagnm_rough( i ) - end do - n = n + n_dlcat + 1 - diagnm( n ) = fdiagnm( 7 ) ! Cropland_Rough - - n = n - 7 ! add remaining variables in fdiagnm - do i = 8, fndust_diag - idiag = i+n - diagnm( idiag ) = fdiagnm( i ) - end do - -C...append diagnostic variables with mass emissions species - do j = 2, n_mode - do i = 1, ndust_spc - n = len_trim( dust_spc( i )%name( j ) ) - if( n .lt. 1 )cycle ! assumes cmaq species names atleast one character long - n = 0 - do k = 1, idiag ! determine if dust emissions is already added to diagnostic output - if( dust_spc( i )%name( j ) .Eq. diagnm( k )%var )Then - n = k - exit - end if - end do - if( n .gt. 0 )then ! skip already added - cycle - else - idiag = idiag + 1 - diagnm( idiag )%var = dust_spc( i )%name( j ) - end if - diagnm( idiag )%units = 'g/m**3/s' - Select Case( j ) ! assumes only two aerosol modes dust emissions -! Case( 1 ) -! diagnm( idiag )%desc = 'aitken mode' - Case( 2 ) - diagnm( idiag )%desc = 'accumulation mode' - Case( 3 ) - diagnm( idiag )%desc = 'coarse mode' -! Case Default -! diagnm( idiag )%des = 'Undefined mode ' - end Select - diagnm( idiag )%desc = Trim( diagnm( idiag )%desc ) - & // ' emissions for ' - & // Trim( dust_spc( i )%description ) - end do - end do - -! remove unused space in diagnm by deallocated and reallocating to idiag value - allocate( diagnm_swap( ndust_diag ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating DIAGNM_SWAP' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - diagnm_swap = diagnm - - deallocate( diagnm ) - - ndust_diag = idiag - allocate( diagnm( ndust_diag ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure reallocating DIAGNM' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - end if - diagnm( 1:ndust_diag ) = diagnm_swap( 1:ndust_diag ) - deallocate( diagnm_swap ) - - sdate = envint( 'CTM_STDATE', 'Scenario Start (YYYYJJJ)', 0, status ) - stime = envint( 'CTM_STTIME', 'Scenario Start (HHMMSS)', 0, status ) - - if ( io_pe_inclusive ) - & call opdust_emis ( sdate, stime, tstep, ndust_diag, diagnm ) - - end if ! dustem_diag - -C Get env var for erodible agriculture land fraction - erode_agland = .false. ! default - vardesc = 'Flag for calculating erodible agriculture land fraction' - erode_agland = envyn( ctm_erode_agland, vardesc, erode_agland, status ) - if ( status .ne. 0 ) write( logdev,'( 5x, a )' ) vardesc - if ( status .eq. 1 ) then - xmsg = 'Environment variable improperly formatted' - call m3warn( pname, jdate, jtime, xmsg ) - success = .false.; return - else if ( status .eq. -1 ) then - xmsg = 'Environment variable set, but empty ... Using default:' - write( logdev,'( 5x, a, i9 )' ) xmsg, jtime - else if ( status .eq. -2 ) then - xmsg = 'Environment variable not set ... Using default:' - write( logdev,'( 5x, a, i9 )' ) xmsg, jtime - end if - - if ( erode_agland ) then - call cropcal ( sdate, stime, agland ) - do r = 1, my_nrows - do c = 1, my_ncols - if ( agland( c,r ) .lt. 0.0 .or. agland( c,r ) .gt. 100.0 ) then - xmsg = '*** ERROR in AGLAND' - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - end do - end do - end if - -C Get transport factor within canopy and 4 land use type percents - call tfbelow ( jdate, jtime, tfb ) - - l2sgj = log( sigj ) * log( sigj ) - l2sgk = log( sigk ) * log( sigk ) - -C Factors for converting 3rd moment emission rates into number and 2nd moment -C emission rates. (Diameters in [um] changed to [m] ) See Equations 7b and 7c -C of Binkowski & Roselle (2003) - factnumj = 1.0e18 * exp( 4.5 * l2sgj ) / dgvj ** 3 - factnumk = 1.0e18 * exp( 4.5 * l2sgk ) / dgvk ** 3 - factm2j = 1.0e06 * exp( 0.5 * l2sgj ) / dgvj - factm2k = 1.0e06 * exp( 0.5 * l2sgk ) / dgvk - factsrfj = pi * factm2j - factsrfk = pi * factm2k - -C Calculate modal average dust particle densities (accum and coarse modes) [ kg/m**3 ] -C The following works because the dust_spc`s are a fixed split of the total emitted -C mass. - dustmode_dens( 1 ) = 0.0 - do n = 2, n_mode - sumsplit = 0.0; sumfrac = 0.0 - do i = 1, ndust_spc - idx = findAero( dust_spc( i )%name( n ), .true. ) - if( aerospc( idx )%tracer )cycle - if( dust_spc( i )%spcfac( n ) .lt. 1.0e-30 )cycle - sumsplit = sumsplit + dust_spc( i )%spcfac( n ) ! should = 1.0 - sumfrac = sumfrac + dust_spc( i )%spcfac( n ) / aerospc( idx )%density - end do - dustmode_dens( n ) = sumsplit / sumfrac - end do - -#ifdef verbose_wbdust - write( logdev,* ) ' ' - write( logdev,* ) ' l2sgj,l2sgk: ', l2sgj, l2sgk - write( logdev,* ) ' factnumj,factnumk: ', factnumj, factnumk - write( logdev,* ) ' factm2j,factm2k: ', factm2j, factm2k - write( logdev,* ) ' factsrfj,factsrfk: ', factsrfj, factsrfk - write( logdev,* ) ' modal avg dens(j/k): ', dustmode_dens( 2 ), dustmode_dens( 3 ) - write( logdev,* ) ' ' -#endif - - end function dust_emis_init - -C======================================================================= - subroutine opdust_emis ( jdate, jtime, tstep, ndust_var, dust_var ) - -C 27 Dec 10 J.Young: initial - - use grid_conf ! horizontal & vertical domain specifications - use utilio_defn - - implicit none - - include SUBST_FILES_ID ! file name parameters - -C Arguments: - integer, intent( in ) :: jdate ! current model date, coded YYYYDDD - integer, intent( in ) :: jtime ! current model time, coded HHMMSS - integer, intent( in ) :: tstep ! output time step - integer, intent( in ) :: ndust_var - type( diag_type ), intent( in ) :: dust_var( : ) - -C Local variables: - character( 16 ) :: pname = 'OPDUST_EMIS' - character( 96 ) :: xmsg = ' ' - - integer v, l ! loop induction variables - -C----------------------------------------------------------------------- - -C Try to open existing file for update - if ( .not. open3( ctm_dust_emis_1, fsrdwr3, pname ) ) then - xmsg = 'Could not open CTM_DUST_EMIS_1 for update - ' - & // 'try to open new' - call m3mesg( xmsg ) - -C Set output file characteristics based on COORD.EXT and open diagnostic file - ftype3d = grdded3 - sdate3d = jdate - stime3d = jtime - tstep3d = tstep - call nextime( sdate3d, stime3d, tstep3d ) ! start the next hour - - nvars3d = ndust_var - ncols3d = gl_ncols - nrows3d = gl_nrows - nlays3d = 1 - nthik3d = 1 - gdtyp3d = gdtyp_gd - p_alp3d = p_alp_gd - p_bet3d = p_bet_gd - p_gam3d = p_gam_gd - xorig3d = xorig_gd - yorig3d = yorig_gd - xcent3d = xcent_gd - ycent3d = ycent_gd - xcell3d = xcell_gd - ycell3d = ycell_gd - vgtyp3d = vgtyp_gd - vgtop3d = vgtop_gd -! vgtpun3d = vgtpun_gd ! currently, not defined - do l = 1, nlays3d + 1 - vglvs3d( l ) = vglvs_gd( l ) - end do - gdnam3d = grid_name ! from HGRD_DEFN - - do v = 1, nvars3d - vtype3d( v ) = m3real - vname3d( v ) = dust_var( v )%var - units3d( v ) = dust_var( v )%units - vdesc3d( v ) = dust_var( v )%desc - end do - - fdesc3d( 1 ) = 'windblown dust parameters, variables, and' - fdesc3d( 2 ) = 'hourly layer-1 windblown dust emission rates' - do l = 3, mxdesc3 - fdesc3d( l ) = ' ' - end do - -C Open windblown dust emissions diagnostic file - if ( .not. open3( ctm_dust_emis_1, fsnew3, pname ) ) then - xmsg = 'Could not create the CTM_DUST_EMIS_1 file' - call m3exit( pname, sdate3d, stime3d, xmsg, xstat1 ) - end if - - end if - - return - - end subroutine opdust_emis - -C======================================================================= - subroutine get_dust_emis( jdate, jtime, tstep, rjacm, cellhgt ) - - use grid_conf ! horizontal & vertical domain specifications - use asx_data_mod ! meteorology data - use aero_data - use utilio_defn - -C 8/18/11 D.Wong: incorporated twoway model implementation and change -C RC -> RCA and RN -> RNA and made it backward compatible -C 8/12/15 D.Wong: added code to handle parallel I/O implementation - -C Arguments: - integer, intent( in ) :: jdate ! current model date, coded YYYYDDD - integer, intent( in ) :: jtime ! current model time, coded HHMMSS - integer, intent( in ) :: tstep( 3 ) ! output time step, sync step, 2way step - real, intent( in ) :: rjacm( ncols,nrows ) ! reciprocal Jacobian [1/m] - real, intent( in ) :: cellhgt ! grid-cell height [sigma] - -C Includes: - include SUBST_FILES_ID ! file name parameters - -C External Functions: - -C Parameters: - integer, parameter :: ndp = 4 ! number of soil texture type particle sizes: - ! 1 Coarse sand - ! 2 Fine-medium sand - ! 3 Silt - ! 4 Clay - - real, parameter :: f6dpi = 6.0 / pi - real, parameter :: gpkg = 1.0e03 ! g/kg - - real, parameter :: mv = 0.16 - real, parameter :: sigv = 1.45 - real, parameter :: betav = 202.0 - real, parameter :: sigv_mv = sigv * mv ! = 0.232 - real, parameter :: betav_mv = betav * mv ! = 32.32 - real, parameter :: mb = 0.5 - real, parameter :: sigb = 1.0 - real, parameter :: betab = 90.0 - real, parameter :: sigb_mb = sigb * mb ! = 0.5 - real, parameter :: betab_mb = betab * mb ! = 45.0 - - real, parameter :: alpha = 0.7 - - character( 16 ) :: pname = 'GET_DUST_EMIS' - character( 16 ) :: vname - character( 96 ) :: xmsg - integer status - integer c, r, j, m, n, v - - integer, save :: wstep = 0 ! local write counter - integer :: mdate, mtime ! diagnostic file write date&time - - ! automatic arrays - real :: fmoit ( ncols,nrows ) ! factor of soil moisture on u*t - real :: soimt ( ncols,nrows ) ! gravimetric soil moisture (Kg/Kg) - real :: tfa ( ncols,nrows ) ! transport fraction above canopy - real :: wrbuf ( ncols,nrows ) ! diagnositc write buffer - real :: vegfrac( ncols,nrows ) ! vegetation fraction - real :: vegfree ! 1.0 - vegfrac for this col, row - real :: lai ( ncols,nrows ) ! leaf area index - - real, allocatable, save :: ustr ( :,:,: ) ! U* [m/s] - real, allocatable, save :: qam ( :,:,: ) ! emis for landuse type [g/m**2/s] - real, allocatable, save :: elus ( :,:,: ) ! erodible landuse percent (0~100) - real, allocatable, save :: fruf ( :,:,: ) ! surface roughness factor - - real :: edust( n_mode ) ! mass emis rate [g/s] per mode (only accum & coarse) - real :: sumdfr ! sum var for desert fraction - real :: rlay1hgt ! reciprocal of layer-1 height [1/m] - real :: m3j ! 3rd moment accumulation (J) mode emis rates [m3/m3/s] - real :: m3k ! 3rd moment coarse mode (K) emis rates [m3/m3/s] - real :: fruf2 ! surface roughness factor squared - - character( 16 ), save :: rc_name, rn_name ! new names: RC -> RCA, RN -> RNA - logical, save :: firstime = .true. - - real :: lambda, vegheight - real :: z0 - real :: lambdav ! vegetation roughness density - Shao et. al [Aus. J. Soil Res., 1996] - real :: flxfac1, flxfac2 ! combined soli type mapping factors - real :: hflux, vflux ! horizontal and vertical dust flux - real :: jday - integer :: emap( n_dlcat+1 ) - -C---FENGSHA FLAG - -C CHARACTER( 20 ), SAVE :: CTM_FENGHSA = 'CTM_FENGSHA ' ! env var for in-line -C LOGICAL, SAVE :: FENGSHA ! flag in-lining canopy shading - -C---Height for veg elements - real :: hv( 4 ) - -C---Roughness density for solid elements -C from Darmenova et al. [JGR,2009] and Xi and Sokolik [JGR,2015] - real :: lambdab( 4 ) = - & (/ 0.03, ! shrubland - & 0.04, ! shrubgrass - & 0.0001, ! barrenland - & 0.15 /) ! cropland - -C---Compound for computational efficiency - real :: hb_lambdab( 4 ) = - & (/ 6.0e-04, ! shrubland - & 8.0e-04, ! shrubgrass - & 2.0e-06, ! barrenland - & 3.0e-03 /) ! cropland - -C Soil moisture limit: 13 types and 3 variables, which are: -C 1 - saturation moisture limit, (gravimetric units assumed, Kg/Kg) -C 2 - fill capacity, and <- not used -C 3 - wilting point <- not used -C Modified values compatiable with both MM5 & NAM. -C Silt values are based on NAM documentation on soil types. -C Other includes all types higher than 12. The values of Other, serving as -C placeholders, are randomly chosen. Values of Other, however, have no effect -C on dust emissions as the threshold velocity of Other will be high. -C real :: soilml( nsltyp,3 ) = reshape ( -C & (/ 0.395, 0.135, 0.068, ! Sand -C & 0.410, 0.150, 0.075, ! Loamy Sand -C & 0.435, 0.195, 0.114, ! Sandy Loam -C & 0.485, 0.255, 0.179, ! Silt Loam -C & 0.476, 0.361, 0.084, ! Silt -C & 0.451, 0.240, 0.155, ! Loam -C & 0.420, 0.255, 0.175, ! Sandy Clay Loam -C & 0.477, 0.322, 0.218, ! Silty Clay Loam -C & 0.476, 0.325, 0.250, ! Clay Loam -C & 0.426, 0.310, 0.219, ! Sandy Clay -C & 0.482, 0.370, 0.283, ! Silty Clay -C & 0.482, 0.367, 0.286, ! Clay -C & 0.482, 0.367, 0.286 /), ! Other -C & (/ nsltyp,3 /), order = (/ 2,1 /) ) ! fill columns first - -C converted to gravimetric [kg/kg] - real :: soilml1( nsltyp ) = - & (/ 0.242, ! Sand - & 0.257, ! Loamy Sand - & 0.286, ! Sandy Loam - & 0.350, ! Silt Loam - & 0.350, ! Silt - & 0.307, ! Loam - & 0.277, ! Sandy Clay Loam - & 0.350, ! Silty Clay Loam - & 0.332, ! Clay Loam - & 0.284, ! Sandy Clay - & 0.357, ! Silty Clay - & 0.344, ! Clay - & 0.363 /) ! Other - -C---Soil texture: the amount of -C 1: Coarse sand, 2: Fine-medium sand, 3: Silt, 4: Clay -C in each soil type [Kg/Kg]. from Menut et al. [JGR,2013] - real :: soiltxt( nsltyp,ndp ) = reshape ( - & (/ 0.46, 0.46, 0.05, 0.03, ! Sand - & 0.41, 0.41, 0.18, 0.00, ! Loamy Sand - & 0.29, 0.29, 0.32, 0.10, ! Sandy Loam - & 0.00, 0.17, 0.70, 0.13, ! Silt Loam - & 0.00, 0.10, 0.85, 0.05, ! Silt - & 0.00, 0.43, 0.39, 0.18, ! Loam - & 0.29, 0.29, 0.15, 0.27, ! Sandy Clay Loam - & 0.00, 0.10, 0.56, 0.34, ! Silty Clay Loam - & 0.00, 0.32, 0.34, 0.34, ! Clay Loam - & 0.00, 0.52, 0.06, 0.42, ! Sandy Clay - & 0.00, 0.06, 0.47, 0.47, ! Silty Clay - & 0.00, 0.22, 0.20, 0.58, ! Clay - & 0.00, 0.00, 0.00, 0.00 /), ! Other - & (/ nsltyp,4 /), order = (/ 2,1 /) ) ! fill columns first - -C---Mean mass median particle diameter (m) for each soil texture type -C Chatenet et al. [Sedimentology,1996] and Menut et al. [JGR,2013] - real :: dp( ndp ) = - & (/ 690.0E-6, ! Coarse sand - & 210.0E-6, ! Fine-medium sand - & 125.0E-6, ! Silt - & 2.0E-6 /) ! Clay - - - interface - subroutine tfabove ( tfa ) - real, intent( out ) :: tfa( :,: ) - end subroutine tfabove - end interface - -#ifdef verbose_wbdust - integer dryhit - integer dusthit -#endif - -C----------------------------------------------------------------------- - - if ( firstime ) then - -! FENGHSA = ENVYN( 'CTM_FENGSHA', -! & 'Flag for fengsha dust emission module', -! & .FALSE., IOSX ) - IF ( FENGSHA ) THEN - XMSG = 'Using Fengsha dust emission module ' - CALL M3MSG2( XMSG ) - END IF - - firstime = .false. - allocate ( ustr( ncols,nrows,n_dlcat+1 ), - & qam( ncols,nrows,n_dlcat+1 ), - & fruf( ncols,nrows,n_dlcat+1 ), - & kvh( ncols,nrows,n_dlcat+1 ), - & elus( ncols,nrows,n_dlcat+1 ), stat = status ) - if ( status .ne. 0 ) then - xmsg = '*** Failure allocating USTR, QAM, FRUF, KVH, or ELUS' - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - end if - -C---Calculate transport factor above the canopy - call tfabove ( tfa ) - -C---Get Julian day number in year - jday = float( mod( jdate,1000 ) ) - -C---Vegetation height dynamically changed based on the month of the year -C Veg. heights in [m] for 1: Shrubland 2: shrubgrass 3: barrenland 4: Cropland -C following the idea of Xi and Sokolik [JGR,2015] - if ( jday .gt. 59 .and. jday .le. 90 ) then ! Mar - hv = (/ 0.15 , 0.05 , 0.10 , 0.05 /) - else if ( jday .gt. 90 .and. jday .le. 120 ) then ! Apr - hv = (/ 0.15 , 0.10 , 0.10 , 0.05 /) - else if ( jday .gt. 120 .and. jday .le. 151 ) then ! May - hv = (/ 0.12 , 0.20 , 0.10 , 0.10 /) - else if ( jday .gt. 151 .and. jday .le. 181 ) then ! Jun - hv = (/ 0.12 , 0.15 , 0.10 , 0.30 /) - else if ( jday .gt. 181 .and. jday .le. 212 ) then ! Jul - hv = (/ 0.10 , 0.12 , 0.10 , 0.50 /) - else if ( jday .gt. 212 .and. jday .le. 243 ) then ! Aug - hv = (/ 0.10 , 0.12 , 0.10 , 0.50 /) - else if ( jday .gt. 243 .and. jday .le. 273 ) then ! Sep - hv = (/ 0.10 , 0.10 , 0.10 , 0.30 /) - else if ( jday .gt. 273 .and. jday .le. 304 ) then ! Oct - hv = (/ 0.05 , 0.08 , 0.10 , 0.10 /) - else ! Nov-Feb - hv = (/ 0.05 , 0.05 , 0.05 , 0.05 /) - end if - -#ifdef verbose_wbdust - dryhit = 0 - dusthit = 0 -#endif - -C Initialize windblown dust diagnostics output buffer - if ( dustem_diag .and. wstep .eq. 0 ) then - dustbf = 0.0 ! array assignment -#ifdef verbose_wbdust - sdiagv = 0.0 ! array assignment -#endif - end if - -C set erodible landuse map - do m = 1, n_dlcat - emap( m ) = dmap( m ) ! dmap maps to one of the 3 BELD3 desert types - end do - emap( n_dlcat+1 ) = 4 - -C --------- ###### Start Main Loop ###### --------- - - do r = 1, my_nrows - do c = 1, my_ncols - dust_em( c,r ) = 0.0 - soimt( c,r ) = 0.0 - fmoit( c,r ) = 0.0 ! for diagnostic output visualization - vegfrac( c,r ) = 0.0 - do m = 1, n_dlcat+1 - ustr( c,r,m ) = 0.0 ! for diagnostic output visualization - qam ( c,r,m ) = 0.0 - elus( c,r,m ) = 0.0 - fruf( c,r,m ) = 0.0 - kvh ( c,r,m ) = 0.0 - end do - - rlay1hgt = rjacm ( c,r ) / cellhgt - -C---Vegetation fraction based on the MODIS FPAR - vegfrac( c,r ) = max( min( fpar( c,r ), 0.95 ), 0.005 ) - vegfree = 1.0 - vegfrac( c,r ) - lambdav = -0.35 * log( vegfree ) ! Shao et al. [Aus. J. Soil Res.,1996] - -C---Dust possiblity only if 1. not over water -C 2. rain < 1/100 in. (1 in. = 2.540 cm) -C 3. not snow-covered -C 4. if soimt <= limit -C 5. desert type or ag landuse -C 6. erodible landuse -C 7. friction velocity > threshold - -!----------------------------------------------------------- -!---------------------- FENGSHA Option --------------------- -!----------------------------------------------------------- - - if ( ( FENGSHA.eq. .true.) .and. ( Grid_Data%lwmask( c,r ) .gt. 0.0 ) .and. - & ( Met_Data%rn( c,r ) + Met_Data%rc( c,r ) .le. 0.0254 ) .and. ! rn, rc = [cm] - & ( Met_Data%snocov( c,r ) .lt. 0.001 ) .and. - & ( Met_Data%drag(c,r) .gt. 0.0 ) ) then ! less than 0.1% snow coverage - -C Calculate maximum amount of the water absorbed -C w` = 0.0014(%clay)**2 + 0.17(%clay) - w` in % -C Fecan et al. [1999,Annales Geophys.,17,144-157] - wmax ( c,r ) = (100.*Met_Data%clayf( c,r )) * - & (100.*Met_Data%clayf( c,r )) * - & .0014d0 + 0.17d0 * (100.*Met_Data%clayf( c,r )) - - soimt( c,r ) = dust_volumetric_to_gravimetric( Met_Data%soim1( c,r ), Met_Data%clayf( c,r ), Met_Data%sandf( c,r )) - -C---Soil moisture effect on U*t - if ( soimt( c,r ) .le. 0.01 * wmax( c,r ) ) then ! wmax in [%] - fmoit( c,r ) = 1.0 - else - fmoit( c,r ) = sqrt( 1.0 + 1.2 * ( 100.0 * soimt( c,r ) - wmax( c,r ) ) ** 0.68 ) - end if - -C Calculate Vertical to Horizontal Mass Flux Ratio -C -- This is based on MB95 - if ( Met_Data%clayf(c,r) < 0.2) then - kvh( c,r,1 ) = 10. ** (0.134 * (Met_Data%clayf( c,r )*100.) - 6.0) - else - kvh(c,r,1) = 4.0e-4 - endif -C Horizontal Flux - hflux = dust_hflux_fengsha( Met_Data%USTAR( c,r ), - & fmoit( c,r), - & Met_Data%drag( c,r ), - & Met_Data%uthr( c,r ), - & 1.0, ! ssm = 1 - & Met_Data%dens1( c,r ) ) - vflux = hflux * kvh( c,r,1 ) ! [g/m**2/s] - - qam (c,r,1) = qam(c,r,1) + vflux * rlay1hgt * alpha - - dust_em( c,r ) = dust_em( c,r ) + qam(c,r,1) * tfa(c,r) * tfb(c,r) - - -!-------------------------------------------------------------------- -!--------------------- END OF FENGSHA ------------------------------- -!-------------------------------------------------------------------- - - else if ( ( Grid_Data%lwmask( c,r ) .gt. 0.0 ) .and. - & ( Met_Data%rn( c,r ) + Met_Data%rc( c,r ) .le. 0.0254 ) .and. ! rn, rc = [cm] - & ( Met_Data%snocov( c,r ) .lt. 0.001 ) ) then ! less than 0.1% snow coverage - -C---Dust possiblity 1,2,3 - - j = Grid_Data%sltyp( c,r ) - -C kludge (fixed in wrf-px after 4 Mar 11) - if ( j .gt. 4 ) j = j + 1 ! PX combines "silt" with "silt loam" - if ( j .gt. 13 ) j = 13 ! = ? - -C Calculate maximum amount of the adsorbed water -C w` = 0.0014(%clay)**2 + 0.17(%clay) - w` in % -C Fecan et al. [1999,Annales Geophys.,17,144-157] - wmax( c,r ) = ( 14.0 * soiltxt( j,4 ) + 17.0 ) * soiltxt( j,4 ) ! [%] - -! write( logdev,'( 2x, a, i8.6, f12.5 )' ) 'max wmax:', jtime, maxval( wmax ) - -C Change soil moisture units from volumetric (m**3/m**3) to gravimetric (Kg/Kg) - soimt( c,r ) = Met_Data%soim1( c,r ) ! <- [m**3/m**3] - & * 1000.0 / ( 2650.0 * ( 0.511 + 0.126 - & * ( soiltxt( j,1 ) + soiltxt( j,2 ) ) ) ) - - if ( soimt( c,r ) .le. soilml1( j ) ) then -C---Dust possiblity 4 - -#ifdef verbose_wbdust - dryhit = dryhit + 1 -#endif - -C---Soil moisture effect on U*t - if ( soimt( c,r ) .le. 0.01 * wmax( c,r ) ) then ! wmax in [%] - fmoit( c,r ) = 1.0 - else - fmoit( c,r ) = sqrt( 1.0 + 1.21 - & * ( 100.0 * soimt( c,r ) - wmax( c,r ) ) ** 0.68 ) - end if - -C---Erodibility potential of soil component - sd_ep( c,r ) = soiltxt( j,4 ) * eropot( 1 ) - & + soiltxt( j,3 ) * eropot( 2 ) - & + ( soiltxt( j,1 ) + soiltxt( j,2 ) ) * eropot( 3 ) - -C---Lu and Shao [JGR,1999] and Kang et al. [JGR,2011] -C First, mapping soil types into 4 main soil types following Kang et al. [JGR,2011] - select case ( j ) - case( 1, 2 ) ! sand - ! pp = 5000.0 - ! calpha = 0.001 - ! pfrac = 0.06 - ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp - flxfac1 = 5.886e-05 - ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) - flxfac2 = 1.5215430 - case( 3, 4, 6, 8, 9 ) ! loam - ! pp = 10000.0 - ! calpha = 0.0006 - ! pfrac = 0.18 - ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp - flxfac1 = 5.2974e-05 - ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) - flxfac2 = 1.0758933 - case( 7 ) ! sandy clay loam - ! pp = 10000.0 - ! calpha = 0.0006 - ! pfrac = 0.32 - ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp - flxfac1 = 9.4176e-05 - ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) - flxfac2 = 1.0758933 - case( 5, 10, 11, 12 ) ! clay - ! pp = 30000.0 - ! calpha = 0.0002 - ! pfrac = 0.72 - ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp - flxfac1 = 2.3544e-05 - ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) - flxfac2 = 0.1964303 - case default ! others -- no dust - ! pp = 100000.0 - ! calpha = 1.0 - ! pfrac = 0.0 - ! flxfac1 = calpha * 9.81 * pfrac * 500.0 / pp - flxfac1 = 0.0 - ! flxfac2 = 2.09 * sqrt( 2650.0 / pp ) - flxfac2 = 0.3402273 - end select - - do m = 1, n_dlcat ! desert type landuse category - elus( c,r,m ) = ladut( c,r,m ) * vegfree ! desert land [%] - end do - elus( c,r,n_dlcat+1 ) = agland( c,r ) * vegfree ! crop land [%] - -C ------- Start Loop Over Erodible Landuse ---- - - do m = 1, n_dlcat+1 ! desert type & crop landuse categories - - if ( elus( c,r,m ) .gt. 100.0 .or. elus( c,r,m ) .lt. 0.0 ) then - write( xmsg,2009 ) elus( c,r,m ), c, r, m - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - - if ( elus( c,r,m ) .gt. 0.0 ) then - - n = emap( m ) - lambda = lambdab( n ) + lambdav - vegheight = ( hb_lambdab( n ) + hv( n ) * lambdav ) / lambda - -C---New parametrization for surface roughness by H. Foroutan - Oct. 2015 - if ( lambda .le. 0.2 ) then - z0 = 0.96 * ( lambda ** 1.07 ) * vegheight - else - z0 = 0.083 * ( lambda ** ( -0.46 ) ) * vegheight - end if - -C---Calculate friction velocity (U*) at the surafce applicable to dust emission - ustr( c,r,m ) = karman * Met_Data%WSPD10( c,r ) / log ( 10.0 / z0 ) - -C---Roughness effect on U*t (Drag partitioning) -C Xi and Sokolik [JGR,2015] - fruf2 = ( 1.0 - sigv_mv * lambdav ) - & * ( 1.0 + betav_mv * lambdav ) - & * ( 1.0 - sigb_mb * lambdab( n ) / vegfree ) - & * ( 1.0 + betab_mb * lambdab( n ) / vegfree ) - - if( fruf2 .gt. 1.0 ) then - - fruf( c,r,m ) = sqrt( fruf2 ) - else - fruf( c,r,m ) = 10.0 - end if - -C---Vert-to-Horiz dust flux ratio : Kang et al. [JGR, 2011] : Eq. (12) -! kvh( c,r,m ) = ( calpha * 9.81 * pfrac * 1000.0 / 2.0 / pp ) -! & * ( 0.24 + 2.09 * ustr( c,r,m ) * sqrt( 2650.0 / pp ) ) - kvh( c,r,m ) = flxfac1 * ( 0.24 + flxfac2 * ustr( c,r,m ) ) - hflux = dust_hflux( ndp, dp, - & soiltxt( j,: ), - & fmoit( c,r ), - & fruf( c,r,m ), - & ustr( c,r,m ), - & sd_ep( c,r ), - & Met_Data%dens1( c,r ) ) - vflux = hflux * kvh( c,r,m ) ! [g/m**2/s] - qam( c,r,m ) = qam( c,r,m ) + vflux * rlay1hgt - & * ( elus( c,r,m ) * 0.01 ) ! [g/m**3/s] - end if ! if erodible land - - if ( elus( c,r,m ) .eq. 0.0 .and. qam( c,r,m ) .ne. 0.0 ) then - xmsg = 'Erodible land use = 0, but emissions .ne. 0' - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - - dust_em( c,r ) = dust_em( c,r ) + qam( c,r,m ) - - end do ! m landuse - -C ------- End Loop Over Erodible Landuse ---- - -C Dust removal by surrounding vegetation <-??? -C Adjust dust emissions for transport factors - - dust_em( c,r ) = dust_em( c,r ) * tfa( c,r ) * tfb( c,r ) - - end if ! if soil moisture - end if ! if rain & land & snow - - end do ! c - end do ! r - -C --------- ###### End Main Loop ##### --------- - -#ifdef verbose_wbdust - write( logdev,'( /5x, a, 1x, 2i8 )' ) 'dry hit count, - & out of total cells:', - & dryhit, (c-1)*(r-1) -#endif - - do r = 1, my_nrows - do c = 1, my_ncols - -C J/K mass emis rate [g/s] (edust( 1 ) not used) - edust( 2 ) = fracmj * dust_em( c,r ) - edust( 3 ) = fracmk * dust_em( c,r ) - - do v = 1, ndust_spc - dustoutm( v,1,c,r ) = 0.0 - end do - - do n = 2, n_mode - do v = 1, ndust_spc - dustoutm( v,n,c,r ) = edust( n ) * dust_spc( v )%spcfac( n ) - end do - end do - -C J/K 3rd moment emis rate [m3/s] (needed for number and surface) - m3j = edust( 2 ) * f6dpi / ( gpkg * dustmode_dens( 2 ) ) - m3k = edust( 3 ) * f6dpi / ( gpkg * dustmode_dens( 3 ) ) - -C Mode-specific emission rates of particle number [1/s] - dustoutn( 1,c,r ) = 0.0 - dustoutn( 2,c,r ) = m3j * factnumj - dustoutn( 3,c,r ) = m3k * factnumk - -C Mode-specific dry surface area emission rates [m**2/s]. -C 2nd moment multiplied by PI to obtain the surface area emissions rate. - dustouts( 1,c,r ) = 0.0 - dustouts( 2,c,r ) = m3j * factsrfj - dustouts( 3,c,r ) = m3k * factsrfk - -#ifdef verbose_wbdust - if ( m3j .ne. 0.0 ) dusthit = dusthit + 1 -#endif - - if ( dustem_diag ) then - do m = 1, n_dlcat+1 - diagv( m ) = qam( c,r,m ) ! g/m**3/s - end do - n = n_dlcat + 2 - diagv( n ) = dust_em( c,r ) ! g/m**3/s - - sumdfr = 0.0 - do m = 1, n_dlcat+1 - diagv( m+n ) = elus( c,r,m ) - sumdfr = sumdfr + elus( c,r,m ) - end do - n = n + n_dlcat + 2 - diagv( n ) = sumdfr - - do m = 1, n_dlcat+1 - diagv( m+n ) = ustr( c,r,m ) - end do - n = n + n_dlcat + 1 - - do m = 1, n_dlcat+1 - diagv( m+n ) = kvh( c,r,m ) - end do - n = n + n_dlcat + 1 - - do m = 1, n_dlcat+1 - diagv( m+n ) = fruf( c,r,m ) - end do - n = n + n_dlcat + 1 - - diagv( n+1 ) = fmoit( c,r ) ! 'Soil_Moist_Fac ' - diagv( n+2 ) = sd_ep( c,r ) ! 'Soil_Erode_Pot ' - diagv( n+3 ) = wmax ( c,r ) ! 'Mx_Adsrb_H2O_Frc' - diagv( n+4 ) = vegfrac( c,r ) ! 'Vegetation_Frac ' - diagv( n+5 ) = uland( c,r,3 ) ! 'Urban_Cover ' - diagv( n+6 ) = uland( c,r,4 ) ! 'Forest_Cover ' - diagv( n+7 ) = tfa ( c,r ) ! 'Trfac_Above_Can ' - diagv( n+8 ) = tfb ( c,r ) ! 'Trfac_Inside_Can' - - n = n + 8 - -! accum and coarse mode number density emissions - diagv( n+1 ) = dustoutn( 2,c,r ) - diagv( n+2 ) = dustoutn( 3,c,r ) -! accum and coarse mode surface area density emissions - diagv( n+3 ) = dustouts( 2,c,r ) - diagv( n+4 ) = dustouts( 3,c,r ) - - n = n + 4 - m = 0 - do v = 1, ndust_spc - if ( trim( dust_spc( v )%name( 2 ) ) .ne. ' ' ) then ! accum. mode mass emissions - m = m + 1 - diagv( m+n ) = dustoutm( v,2,c,r ) - end if - end do - - do v = 1, ndust_spc - if ( trim( dust_spc( v )%name( 3 ) ) .ne. ' ' ) then ! coarse mode mass emissions - m = m + 1 - diagv( m+n ) = dustoutm( v,3,c,r ) - end if - end do - - n = n + m - - -C Multiply by sync step because when write to output we divide by the output step -C to get a timestep average. - do v = 1, ndust_diag - dustbf( v,c,r ) = dustbf( v,c,r ) + diagv( v ) - & * float( time2sec( tstep( 2 ) ) ) -#ifdef verbose_wbdust - sdiagv( v ) = sdiagv( v ) + diagv( v ) - & * float( time2sec( tstep( 2 ) ) ) -#endif - end do - end if ! dustem_diag - end do ! col - end do ! row - -#ifdef verbose_wbdust - write( logdev,'( 5x, a, 2i8 / )' ) 'dust hit count, out of total cells:', - & dusthit, (c-1)*(r-1) -#endif - - if ( dustem_diag ) then - -C If last call this hour, write out the windblown dust emissions dignostics. -C Then reset the emissions array and local write counter. - - wstep = wstep + time2sec( tstep( 2 ) ) - - if ( wstep .ge. time2sec( tstep( 1 ) ) ) then - if ( .not. currstep( jdate, jtime, sdate, stime, tstep( 1 ), - & mdate, mtime ) ) then - xmsg = 'Cannot get step date and time' - call m3exit( pname, jdate, jtime, xmsg, xstat3 ) - end if - call nextime( mdate, mtime, tstep( 1 ) ) - -#ifdef verbose_wbdust - sdiagv = sdiagv / float( wstep ) ! array assignment - write( logdev,2015 ) jdate, jtime - do v = 1, ndust_diag - if ( diagnm( v )%var(1:4) .ne. 'ANUM' ) then - write( logdev,2019 ) v, diagnm( v )%var, sdiagv( v ) - else - write( logdev,2023 ) v, diagnm( v )%var, sdiagv( v ) - end if - end do - sdiagv = 0.0 ! array assignment -#endif - do v = 1, ndust_diag - do r = 1, my_nrows - do c = 1, my_ncols - wrbuf( c,r ) = dustbf( v,c,r ) / float( wstep ) - end do - end do - - if ( .not. WRITE3( ctm_dust_emis_1, diagnm( v )%var, - & mdate, mtime, wrbuf ) ) then - xmsg = 'Could not write ' // trim( diagnm( v )%var ) - & // ' to CTM_DUST_EMIS_1' - call m3exit( pname, mdate, mtime, xmsg, xstat1 ) - end if - end do - write( logdev,'( /5x, 2( a, 1x ), i8, ":", i6.6 )' ) - & 'Timestep written to CTM_DUST_EMIS_1', - & 'for date and time', mdate, mtime - wstep = 0 - dustbf = 0.0 ! array assignment - end if ! time to write - end if ! dustem_diag - -2009 Format( '*** Erodible landuse incorrect ', 1pe13.5, 1x, 'at: ', 3i4 ) -2015 format( /5x, 'Total grid time-avg sum of dust emis variables at:', - & 1x, i8, ":", I6.6 ) -2019 format( i10, 1x, a, f20.5 ) -2023 format( i10, 1x, a, e20.3 ) - - end subroutine get_dust_emis - -C======================================================================= - function dust_hflux( ndp, dp, soiltxt, fmoit, fruf, ustr, sd_ep, dens ) - & result( hflux ) - -C usage: hflux = dust_flux( ndp, dp, -C soiltxt( j,: ), -C fmoit( c,r ), -C fruf( c,r,m ), -C ustr( c,r,m ), -C sd_ep( c,r ), -C dens( c,r ) ) - - implicit none - - include SUBST_CONST ! for grav - - integer, intent( in ) :: ndp - real, intent( in ) :: dp( ndp ) - real, intent( in ) :: soiltxt( ndp ) - real, intent( in ) :: fmoit, fruf, ustr, sd_ep, dens - real hflux - - real, parameter :: amen = 1.0 ! Marticorena and Bergametti [JGR,1997] - real, parameter :: cfac = 1000.0 * amen / grav - real, parameter :: A = 260.60061 ! 0.0123 * 2650.0 * 9.81 / 1.227 - real, parameter :: B = 1.6540342e-06 ! 0.0123 * 0.000165 / 1.227 - real utstar ! threshold U* [m/s] - real utem ! U term [(m/s)**3] - real fac - integer n - -! I can't initialize dp this way - it has to be passed in since ndp is variable - -C---Mean mass median diameter (m) for each soil texture -C [Chatenet et al., Sedimentology 1996 and Menut et al., JGR 2013] -! real :: dp( ndp ) = -! & (/ 690.0E-6, ! Coarse sand -! & 210.0E-6, ! Fine-medium sand -! & 125.0E-6, ! Silt -! & 2.0E-6 /) ! Clay - - fac = cfac * dens * sd_ep - utem = 0.0 - utstar = 0.0 - hflux = 0.0 - do n = 1, ndp ! loop over dust particle size -! utstar = sqrt( 0.0123 * ( 2650.0 * 9.81 * dp( n ) / 1.227 + 0.000165 -! / 1.227 / dp( n ) ) ) ! X roughness & moisture effects - utstar = sqrt( A * dp( n ) + B / dp( n ) ) * fmoit * fruf !Shao and Lu [JGR,2000] - if ( ustr .gt. utstar ) then ! wind erosion occurs only if U* > U*t -C---Horiz. Flux from White (1979) - utem = ( ustr + utstar ) * ( ustr * ustr - utstar * utstar ) -C---Horiz. Flux from Owen (1964) -! utem = ustr * ( ustr * ustr - utstar * utstar ) - hflux = hflux - & + fac * utem * soiltxt( n ) ! [g/m/s] - end if - end do ! dust particle size - - end function dust_hflux - -C============================================================================== - function dust_volumetric_to_gravimetric(vsoilm,clay,sand) - & result ( gwc ) -C usage: H = dust_volumetric_to_gravimetric(vsoilm(c,r), -C clay(c,r), -C sand(c,r)) - - implicit none - ! INPUTS - real, intent(in) :: vsoilm ! volumetric soil moisture - real, intent(in) :: clay ! clay fraction (0 -> 1) - real, intent(in) :: sand ! sand fraction (0 -> 1) - ! OUTPUTS - real :: H - ! LOCAL - real :: gwc ! gravimetric soil moisture - real :: bulk_dens_dry ! bulk density - real :: limit ! fecan soil moisture limit - real :: wsat ! saturated volumentric water content - real :: mpot ! saturated soil matric potential - - ! parameters - real*8, parameter :: bulk_dens = 2650.0d0 - real*8, parameter :: h20_dens = 1000.0d0 - - ! saturated soil matric potential [ mm H2O ] - mpot = 10.d0 * (10.0d0 ** (1.88d0 - 0.0131d0 * sand )) - - ! saturated volumentric water content [ m3 m-3 ] - wsat = 0.489d0 - 0.00126d0 * sand - - ! Bulk density of dry surface soil [kg m-3] - bulk_dens_dry = bulk_dens * ( 1.0d0 - wsat) - - ! Gravimetric water content [ kg kg-1] - gwc = VSOILM * h20_dens / bulk_dens_dry - if (gwc.ge.1.0e10) then - gwc = 0.d0 - endif - - end function dust_volumetric_to_gravimetric - -C======================================================================= - function dust_hflux_fengsha( ustar, fmoit, drag, uthr, ssm, dens ) - & result( hflux ) - -C hflux = dust_hflux( Met_Data%ustar( c,r), -C & fmoit( c,r ), -C & drag( c,r ), -C & uthr( c,r ), -C & ssm( c,r ), -C & Met_Data%dens1( c,r ) ) - - implicit none - - include SUBST_CONST ! for grav - - real, intent( in ) :: ustar, fmoit, drag, uthr, ssm, dens - real hflux - real rustar - real u_sum - real u_thresh - real fac - - real, parameter :: amen = 1.0 ! Marticorena and Bergametti [JGR,1997] - real, parameter :: cfac = 1000.0 * amen / grav - - fac = cfac * dens - hflux = 0.0 - - rustar = ustar * drag - u_thresh = uthr * fmoit - u_sum = rustar * u_thresh - - - hflux = max(0., rustar - u_thresh) * u_sum * u_sum * fac * ssm - - end function dust_hflux_fengsha - - end module dust_emis - diff --git a/src/model/src/centralized_io_util_module.F b/src/model/src/centralized_io_util_module.F deleted file mode 100644 index f5b0653..0000000 --- a/src/model/src/centralized_io_util_module.F +++ /dev/null @@ -1,282 +0,0 @@ - -!------------------------------------------------------------------------! -! The Community Multiscale Air Quality (CMAQ) system software is in ! -! continuous development by various groups and is based on information ! -! from these groups: Federal Government employees, contractors working ! -! within a United States Government contract, and non-Federal sources ! -! including research institutions. These groups give the Government ! -! permission to use, prepare derivative works of, and distribute copies ! -! of their work in the CMAQ system to the public and to permit others ! -! to do so. The United States Environmental Protection Agency ! -! therefore grants similar permission to use the CMAQ system software, ! -! but users are requested to provide copies of derivative works or ! -! products designed to operate in the CMAQ system to the United States ! -! Government without restrictions as to use by others. Software ! -! that is used with the CMAQ system but distributed under the GNU ! -! General Public License or the GNU Lesser General Public License is ! -! subject to their copyright restrictions. ! -!------------------------------------------------------------------------! - -!------------------------------------------------------------------------! -! This module contains utility functions to support centralized I/O -! implementation - -! Revision History: -! 02/01/19, D. Wong: initial implementation -! 08/01/19, D. Wong: modified code to work with two-way model -! 11/20/19, F. Sidi: Modified time to sec to handle negative numbers -!------------------------------------------------------------------------! - - module centralized_io_util_module - - implicit none - - interface quicksort - module procedure quicksort1d, - & quicksort2d - end interface - - contains - -! ------------------------------------------------------------------------- - recursive subroutine quicksort1d (name, begin, end) - - character (*), intent(out) :: name(:) - integer, intent(in) :: begin, end - - integer :: i, j - character (50) :: str1, str2 - logical :: done - - str1 = name( (begin + end) / 2 ) - i = begin - j = end - done = .false. - do while (.not. done) - do while (name(i) < str1) - i = i + 1 - end do - do while (str1 < name(j)) - j = j - 1 - end do - if (i .ge. j) then - done = .true. - else - str2 = name(i) - name(i) = name(j) - name(j) = str2 - i = i + 1 - j = j - 1 - end if - end do - if (begin < i-1) call quicksort(name, begin, i-1) - if (j+1 < end) call quicksort(name, j+1, end) - - end subroutine quicksort1d - -! ------------------------------------------------------------------------- - recursive subroutine quicksort2d (name, begin, end) - - character (*), intent(out) :: name(:,:) - integer, intent(in) :: begin, end - - integer :: i, j, dsize - character (50) :: str1, str2(3) - logical :: done - - dsize = size(name,2) - str1 = name( (begin + end) / 2, 1 ) - i = begin - j = end - done = .false. - do while (.not. done) - do while (name(i,1) < str1) - i = i + 1 - end do - do while (str1 < name(j, 1)) - j = j - 1 - end do - if (i .ge. j) then - done = .true. - else - str2(1:dsize) = name(i,:) - name(i,:) = name(j,:) - name(j,:) = str2(1:dsize) - i = i + 1 - j = j - 1 - end if - end do - if (begin < i-1) call quicksort(name, begin, i-1) - if (j+1 < end) call quicksort(name, j+1, end) - - end subroutine quicksort2d - -! ------------------------------------------------------------------------- - function binary_search (name, list, n) result (loc) - - character (*), intent(in) :: name, list(:) - integer, intent(in) :: n - integer :: loc - - logical :: found - integer :: mid_loc, start_loc, end_loc - - start_loc = 1 - end_loc = n - found = .false. - do while ((start_loc .le. end_loc) .and. (.not. found)) - mid_loc = start_loc + (end_loc - start_loc) / 2 - if (name .lt. list(mid_loc)) then - end_loc = mid_loc - 1 - else if (name .gt. list(mid_loc)) then - start_loc = mid_loc + 1 - else - found = .true. - end if - end do - - if (found) then - loc = mid_loc - else - loc = -1 - end if - - end function binary_search - -! ------------------------------------------------------------------------- - function search (name, list, n) result (loc) - - character (*), intent(in) :: name, list(:) - integer, intent(in) :: n - integer :: loc - - logical :: found - integer :: lloc - - lloc = 0 - found = .false. - do while ((lloc .le. n) .and. (.not. found)) - lloc = lloc + 1 - if (name .eq. list(lloc)) then - found = .true. - end if - end do - - if (found) then - loc = lloc - else - loc = -1 - end if - - end function search - -! ------------------------------------------------------------------------- - integer function time_to_sec (time) - - integer, intent(in) :: time - integer :: neg_time - integer :: time_in_sec, hr, min, sec - - if (time .gt. 0) then - hr = time / 10000 - min = mod(time/100, 100) - sec = mod(time, 100) - time_to_sec = hr * 3600 + min * 60 + sec - else - neg_time = abs(time) - hr = neg_time / 10000 - min = mod(neg_time/100, 100) - sec = mod(neg_time, 100) - time_to_sec = -1*(hr * 3600 + min * 60 + sec) - end if - - end function time_to_sec - -! ------------------------------------------------------------------------- - integer function time_diff (time1, time2) - - integer, intent(in) :: time1, time2 - - time_diff = time_to_sec(time1) - time_to_sec(time2) - - end function time_diff - -!-------------------------------------------------------------------------- - integer function next_day (jday) - -! This function determermins the next day for time interpolation - implicit none - - integer, intent(in) :: jday - integer year, day - - day = MOD(jday,1000) - year = INT(jday/1000) - - If( day .LT. 365 ) Then - next_day = jday+1 - Else - If( MOD(year,4) .Eq. 0 .And. MOD(year,100) .Ne. 0 ) Then -! Leap Year - If( day .Eq. 365 ) Then - next_day = jday + 1 - Else - next_day = (INT(jday/1000)+1)*1000+1 - End If - Else If(MOD(year,400) .Eq. 0 ) Then -! also a leap year, e.g. 2000 but not 2100 - If( day .Eq. 365 ) Then - next_day = jday + 1 - Else - next_day = (INT(jday/1000)+1)*1000+1 - End If - Else -! not a leap year - next_day = (INT(jday/1000)+1)*1000+1 - End If - End If - - end function next_day - -!-------------------------------------------------------------------------- - - function IntegrateTrapezoid(x, y) - !! Calculates the integral of an array y with respect to x using the trapezoid - !! approximation. Note that the mesh spacing of x does not have to be uniform. - real, intent(in) :: x(:) !! Variable x - real, intent(in) :: y(size(x)) !! Function y(x) - real :: IntegrateTrapezoid !! Integral ∫y(x)·dx - ! Integrate using the trapezoidal rule - associate(n => size(x)) - IntegrateTrapezoid = sum((y(1+1:n-0) + y(1+0:n-1))*(x(1+1:n-0) - x(1+0:n-1)))/2 - end associate - end function - -! --------------------------------------------------------------------------- - - function interp_linear1_internal(x,y,xout) result(yout) - !! Interpolates for the y value at the desired x value, - !! given x and y values around the desired point. - - implicit none - - real, intent(IN) :: x(2), y(2), xout - real :: yout - real :: alph - - if ( xout .lt. x(1) .or. xout .gt. x(2) ) then - write(*,*) "interp1: xout < x0 or xout > x1 !" - write(*,*) "xout = ",xout - write(*,*) "x0 = ",x(1) - write(*,*) "x1 = ",x(2) - stop - end if - - alph = (xout - x(1)) / (x(2) - x(1)) - yout = y(1) + alph*(y(2) - y(1)) - - return - - end function interp_linear1_internal - - end module centralized_io_util_module From ce3e309f47d44a22f76a0b21b968e74524abde66 Mon Sep 17 00:00:00 2001 From: Youhua Tang Date: Fri, 12 Aug 2022 17:22:22 +0000 Subject: [PATCH 39/72] initialize feature/pt-source --- src/model/src/PT3D_DEFN.F | 487 +++++++++++++++++++++++++++++++++++--- src/shr/aqm_methods.F90 | 6 + 2 files changed, 463 insertions(+), 30 deletions(-) diff --git a/src/model/src/PT3D_DEFN.F b/src/model/src/PT3D_DEFN.F index 64e90fc..3759b4c 100644 --- a/src/model/src/PT3D_DEFN.F +++ b/src/model/src/PT3D_DEFN.F @@ -1,5 +1,8 @@ MODULE PT3D_DEFN - + + USE NETCDF + USE ASX_DATA_MOD, ONLY: MET_DATA, GRID_DATA + IMPLICIT NONE LOGICAL, SAVE :: PT3DEMIS ! flag in-lining plume rise @@ -99,7 +102,7 @@ FUNCTION PT3D_INIT ( N_SPC_EMIS, EMLAYS, JDATE, JTIME, TSTEP ) RETURN END IF -C check if emissions are being provided +C check if fire emissions are being provided EM => AQM_EMIS_GET( ETYPE ) IF ( .NOT.ASSOCIATED( EM ) ) RETURN @@ -115,14 +118,8 @@ FUNCTION PT3D_INIT ( N_SPC_EMIS, EMLAYS, JDATE, JTIME, TSTEP ) C set number of emissions layers depending on whether plumerise is on - SELECT CASE ( TRIM( EM % PLUMERISE ) ) - CASE ("sofiev") - EMLYRS = NLAYS - PM_EMLYRS = NLAYS - CASE DEFAULT - EMLYRS = 1 - PM_EMLYRS = 1 - END SELECT + EMLYRS = NLAYS + PM_EMLYRS = NLAYS C get point source emission mapping @@ -172,18 +169,22 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) USE AQM_EMIS_MOD USE AQM_FIRES_MOD USE AQM_RC_MOD - USE RXNS_DATA, ONLY : MECHNAME !Get Chemical Mechanism Name +c use aqm_model_mod, only : aqm_config_type, aqm_state_type, +c & aqm_model_get, aqm_model_domain_get + + USE RXNS_DATA, ONLY : MECHNAME !Get Chemical Mechanism Name USE GRID_CONF ! horizontal & vertical domain specifications USE CGRID_SPCS ! CGRID mechanism species - USE AERO_DATA, ONLY : PMEM_MAP_NAME + USE AERO_DATA, ONLY : N_EMIS_PM, PMEM_MAP_NAME USE PTMAP ! defines pt src species mapping to VDEMIS* arrays USE UTILIO_DEFN + IMPLICIT NONE C Includes: -C INCLUDE SUBST_CONST ! physical and mathematical constants -C INCLUDE SUBST_FILES_ID ! file name parameters (for CTM_PT3D_DIAG) + INCLUDE SUBST_CONST ! physical and mathematical constants + INCLUDE SUBST_FILES_ID ! file name parameters (for CTM_PT3D_DIAG) C Arguments: INTEGER, INTENT( IN ) :: JDATE, JTIME @@ -200,22 +201,419 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) INTEGER IOS ! i/o and allocate memory status INTEGER L, S, V ! counters - INTEGER C, R, K, N + INTEGER C, R, K, N, I, J INTEGER LOCALRC LOGICAL :: IS_NOT_NVPOA, SAVE_POC LOGICAL, SAVE :: FIRSTIME = .TRUE. INTEGER, SAVE :: LOGDEV - TYPE( AQM_INTERNAL_EMIS_TYPE ), POINTER :: EM - -C----------------------------------------------------------------------- - + + REAL TSTK ! temperature at top of stack [K] + REAL TSUM ! tmp layer frac sum for renormalizing + REAL WSTK ! wind speed at top of stack [m/s] + REAL ZBOT ! plume bottom elevation [m] + REAL ZTOP ! plume top elevation [m] + REAL ZDIFF ! ZTOP - ZBOT + REAL DDZ ! 1 / ZDIFF + REAL ZPLM ! plume centerline height above stack [m] + REAL USTMP ! temp storage for ustar [m/s] + REAL HFLX ! converted heat flux + INTEGER LBOT ! layer containing plume bottom + INTEGER LTOP ! layer containing plume top + INTEGER LPBL ! first L: ZF(L) above mixing layer - ONLY for REPORT + INTEGER LSTK ! first L: ZF(L) > STKHT + REAL LFRC ! intermediate LFRAC + character(len=NF90_MAX_NAME) :: path_in + + real zf0,zf1,mxzplm + integer, save :: ntimes,itstep,ncid,iddim_stack,nstack,idvar,nvars,idlists(200), + & id_em_gc(200),id_em_pm(200),indx_gc(200),indx_pm(200), nvars_gc,nvars_pm,ndims, + & elemStart(2),elemCount(2),jstartdate,jstarttime + + real,save :: distnear ! search distrance in km, sqrt(0.5)*model_resolution in km + integer, save, allocatable, dimension (:) :: ixt, jyt + real, save, allocatable, dimension (:) :: tlat,tlon,stkdm,stkht,tfrac, + & stktk,stkve,stkflw,stk_ddzf,stk_pres,stk_dens,stk_qv,stk_ta,stk_wspd,stk_zf,stk_zh,stk_zstk, + & stk_presf,stk_zzf,stk_dthdz,stk_uwind,stk_vwind + real, save, allocatable, dimension (:,:) :: stkemis, my_area + real, save, allocatable, dimension (:,:,:) :: uwind,vwind +c type(aqm_config_type), pointer :: config + + INTERFACE + SUBROUTINE PREPLM( FIREFLG, EMLAYS, HMIX, HTS, PSFC, TS, DDZF, QV, + & TA, UW, VW, ZH, ZF, PRES, LSTK, LPBL, TSTK, + & WSTK, DTHDZ, WSPD ) + LOGICAL, INTENT( IN ) :: FIREFLG ! .true. => processing fire source + INTEGER, INTENT( IN ) :: EMLAYS ! no. emissions layers + REAL, INTENT( IN ) :: HMIX ! mixing height + REAL, INTENT( IN ) :: HTS ! stack height + REAL, INTENT( IN ) :: PSFC ! surface pressure + REAL, INTENT( IN ) :: TS ! surface temperature + REAL, INTENT( IN ) :: DDZF( : ) ! 1/( zf(l) - zf(l-1) ) + REAL, INTENT( IN ) :: QV ( : ) ! mixing ratio + REAL, INTENT( IN ) :: TA ( : ) ! absolute temperature + REAL, INTENT( IN ) :: UW ( : ) ! x-direction winds + REAL, INTENT( IN ) :: VW ( : ) ! y-direction winds + REAL, INTENT( IN ) :: ZH ( : ) ! layer center height [m] + REAL, INTENT( IN ) :: ZF ( : ) ! layer surface height [m] + REAL, INTENT( IN ) :: PRES( 0: ) ! pres at full layer hts (mod by YOJ) + INTEGER, INTENT( OUT ) :: LSTK ! first L: ZF(L) > STKHT + INTEGER, INTENT( OUT ) :: LPBL ! first L: ZF(L) > mixing layer + REAL, INTENT( OUT ) :: TSTK ! temperature @ top of stack [K] + REAL, INTENT( OUT ) :: WSTK ! wind speed @ top of stack [m/s] + REAL, INTENT( OUT ) :: DTHDZ( : ) ! potential temp. grad. + REAL, INTENT( OUT ) :: WSPD ( : ) ! wind speed [m/s] + END SUBROUTINE PREPLM + + SUBROUTINE PLMRIS( EMLAYS, LSTK, HFX, HMIX, + & STKDM, STKHT, STKTK, STKVE, + & TSTK, USTAR, DTHDZ, TA, WSPD, + & ZF, ZH, ZSTK, WSTK, ZPLM ) + INTEGER, INTENT( IN ) :: EMLAYS ! no. of emission layers + INTEGER, INTENT( IN ) :: LSTK ! lyr of top of stack, = RADM's KSTK + REAL, INTENT( IN ) :: HFX ! sensible heat flux [m K/s] + REAL, INTENT( IN ) :: HMIX ! mixing height [m] + REAL, INTENT( IN ) :: STKDM ! stack diameter [m] + REAL, INTENT( IN ) :: STKHT ! stack height [m] + REAL, INTENT( IN ) :: STKTK ! exhaust temperature [deg K] + REAL, INTENT( IN ) :: STKVE ! exhaust velocity [m/s] + REAL, INTENT( IN ) :: TSTK ! tmptr at top of stack [deg K] + REAL, INTENT( IN ) :: USTAR ! friction velocity [m/s] + REAL, INTENT( IN ) :: DTHDZ( : ) ! gradient of THETV + REAL, INTENT( IN ) :: TA ( : ) ! temperature [deg K] + REAL, INTENT( IN ) :: WSPD ( : ) ! wind speed [m/s] + REAL, INTENT( IN ) :: ZF ( 0: ) ! layer surface height [m] + REAL, INTENT( IN ) :: ZH ( : ) ! layer center height [m] + REAL, INTENT( IN ) :: ZSTK ( : ) ! zf( l ) - stkht [m] + REAL, INTENT( INOUT ) :: WSTK ! wind speed @ top of stack [m/s] + REAL, INTENT( OUT ) :: ZPLM ! OUT for reporting, only + END SUBROUTINE PLMRIS ! temporarily, plume top height + END INTERFACE ! above stack, finally plume centerline +C----------------------------------------------------! height [m] (can be greater than the ------------------- + ! height of the top of the EMLAYS layer) IF ( FIRSTIME ) THEN FIRSTIME = .FALSE. LOGDEV = SETUP_LOGDEV() - END IF + + L=nf90_open('NEXUS/PT.nc',nf90_nowrite, ncid) + if(L.ne.nf90_noerr) then + write(logdev,*)'error openning NEXUS/PT.nc' + stop + endif + call check(nf90_inq_dimid(ncid,'nlocs',iddim_stack)) + call check(nf90_inquire_dimension(ncid,iddim_stack,len=nstack)) + allocate(tlat(nstack),tlon(nstack),ixt(nstack),jyt(nstack),stkdm(nstack),stkht(nstack), + & stktk(nstack),stkve(nstack),stkflw(nstack)) + + call check(nf90_inq_varid(ncid,'LATITUDE',idvar)) + call check(nf90_get_var(ncid,idvar,tlat)) + call check(nf90_inq_varid(ncid,'LONGITUDE',idvar)) + call check(nf90_get_var(ncid,idvar,tlon)) + call check(nf90_inq_varid(ncid,'STKDM',idvar)) + call check(nf90_get_var(ncid,idvar,stkdm)) + call check(nf90_inq_varid(ncid,'STKHT',idvar)) + call check(nf90_get_var(ncid,idvar,stkht)) + call check(nf90_inq_varid(ncid,'STKTK',idvar)) + call check(nf90_get_var(ncid,idvar,stktk)) + call check(nf90_inq_varid(ncid,'STKVE',idvar)) + call check(nf90_get_var(ncid,idvar,stkve)) + call check(nf90_inq_varid(ncid,'STKFLW',idvar)) + call check(nf90_get_var(ncid,idvar,stkflw)) + + distnear=0.7071*haversine(grid_data%lat(1,1),grid_data%lon(1,1),grid_data%lat(2,1),grid_data%lon(2,1)) + do n=1,nstack + search_loop: do r = 1, my_nrows + do c = 1, my_ncols + if(haversine(grid_data%lat(c,r),grid_data%lon(c,r),tlat(n),tlon(n)).le.distnear) exit search_loop + enddo + enddo search_loop + if(c.le.my_ncols.and.r.le.my_nrows) then + ixt(n)=c; jyt(n)=r + else + ixt(n)=-999; jyt(n)=-999 + endif + enddo + + call check(nf90_inq_varids(ncid,nvars,idlists)) + + nvars_gc=0 + nvars_pm=0 + do n=1,nvars + call check(nf90_inquire_variable(ncid,idlists(n),vname,ndims=ndims)) + L=index1(vname,n_gc_emis, gc_emis) + if (L > 0) then + + if(ndims.ne.2) then + write(logdev,*)'ndims wrong',ndims,vname + stop + endif + if( PTEM_MAP( L ) .gt.0) then + nvars_gc=nvars_gc+1 + id_em_gc(nvars_gc)=idlists(n) + indx_gc(nvars_gc)=PTEM_MAP( L ) + endif + + else ! aerosol + L=index1(vname,n_emis_pm, pmem_map_name) ! index in pt em + if (L > 0) then + if(ndims.ne.2) then + write(logdev,*)'ndims wrong',ndims,vname + stop + endif + do S=1, N_SPC_PTPM + if(PTPM_MAP(S).eq.L) exit + enddo + if (S. le. N_SPC_PTPM ) then + nvars_pm=nvars_pm+1 + id_em_pm(nvars_pm)=idlists(n) + indx_pm(nvars_pm)=S + endif + endif + endif + enddo + + write(logdev,*)'Point Sources nvars_gc, nvars_pm=',nvars_gc, nvars_pm + write(logdev,*)'ncols,nrows,my_ncols,my_nrows=',ncols,nrows,my_ncols,my_nrows + allocate(my_area(my_ncols,my_nrows)) + if(.not.interpx(GRID_CRO_2D,'AREA','emis',1,my_ncols,1,my_nrows,1,1,jdate,jtime,my_area)) stop + + allocate(stkemis(nstack,nvars_gc+nvars_pm),uwind(my_ncols,my_nrows,emlyrs), vwind(my_ncols,my_nrows,emlyrs), + & stk_ddzf(emlyrs),stk_pres(emlyrs),stk_dens(emlyrs),stk_qv(emlyrs),stk_ta(emlyrs),stk_wspd(emlyrs),stk_zf(emlyrs), + & stk_zh(emlyrs),stk_zstk(emlyrs),stk_dthdz(emlyrs),stk_uwind(emlyrs),stk_vwind(emlyrs),tfrac(emlyrs), + & stk_presf(0:emlyrs),stk_zzf(0:emlyrs)) + + jstartdate=jdate + jstarttime=jtime + END IF + +C ... initialize emission arrays ... + + VDEMIS_PT = 0.0 ! array assignment + VDEMIS_PT_FIRE = 0.0 ! array assignment + PMEMIS_PT = 0.0 ! array assignment + + +C--- anthropogenic point sources + + itstep=secsdiff(jstartdate,jstarttime,jdate,jtime)/3600+1 + write(logdev,*)'process PT emission ',jdate,jtime,tstep(1),itstep + n=nf90_inq_path(ncid,L,path_in) + if(n.ne.nf90_noerr.or.trim(path_in).ne.'NEXUS/PT.nc') then + write(logdev,*)itstep,'ncid wrong, reopen it ',trim(nf90_strerror(n)) + L=nf90_close(ncid) + call check(nf90_open('NEXUS/PT.nc',nf90_nowrite, ncid)) + endif + + elemStart(1)=1; elemStart(2)=itstep + elemCount(1)=nstack; elemCount(2)=1 + do v=1,nvars_gc +c write(logdev,*)'read PT emission of gas ',v,itstep + L=nf90_get_var(ncid,id_em_gc(v),stkemis(:,v),start=elemStart,count=elemCount) + if(L.ne.nf90_noerr) then + write(logdev,*)trim(nf90_strerror(L)),' error reading PT emission of gas ',v,itstep,nstack,id_em_gc(v) + S=nf90_get_var(ncid,id_em_gc(v),stkemis(:,v),start=[1,1],count=elemCount) + if(S.ne.nf90_noerr) then + write(logdev,*)'also error 1-step reading PT emission of gas ',v,trim(nf90_strerror(S)),id_em_gc(v) + else + write(logdev,*)'OK for 1-step reading PT emission of gas ',v,trim(nf90_strerror(S)),id_em_gc(v) + endif + stop + endif + enddo + + do v=1,nvars_pm +c write(logdev,*)'read PT emission of PM ',v + L=nf90_get_var(ncid,id_em_pm(v),stkemis(:,v+nvars_gc),start=elemStart,count=elemCount) + if(L.ne.nf90_noerr) then + write(logdev,*)'error reading PT emission of pm ',v,itstep,nstack,id_em_pm(v) + stop + endif + enddo +c call check(nf90_close(ncid)) + + if(.not.interpx(MET_CRO_3D,'UWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,uwind)) stop + if(.not.interpx(MET_CRO_3D,'VWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,vwind)) stop + + mxzplm=0.0 + + do n=1,nstack + if(ixt(n).lt.1.or.jyt(n).lt.1) cycle + c=ixt(n) + r=jyt(n) + + stk_zf(1:emlyrs)=met_data%zf(c,r,1:emlyrs) + stk_zh(1:emlyrs)=met_data%zh(c,r,1:emlyrs) + stk_zzf(1:emlyrs)=stk_zf(1:emlyrs) + stk_zzf(0)=0. + +c-----calculate ddzf + zf0=stk_zf(1) + stk_ddzf(1)=1./zf0 + stk_zstk(1)=zf0-stkht(n) + do L=2,emlyrs + zf1=stk_zf(L) + stk_zstk(L)=zf1-stkht(n) + stk_ddzf(L)=1./(zf1-zf0) + zf0=zf1 + enddo + + stk_ta(1:emlyrs)=met_data%ta(c,r,1:emlyrs) + stk_qv(1:emlyrs)=met_data%qv(c,r,1:emlyrs) + stk_uwind(1:emlyrs)=uwind(c,r,1:emlyrs) + stk_vwind(1:emlyrs)=vwind(c,r,1:emlyrs) + stk_presf(1:emlyrs)=met_data%pres(c,r,1:emlyrs) ! full level pressure + stk_presf(0)=met_data%prsfc(c,r) + +C Compute derived met vars needed before layer assignments + CALL PREPLM( .FALSE. , EMLYRS, + & Met_Data%PBL(C,R), STKHT(N), met_data%prsfc(c,r), + & Met_Data%TEMP2(C,R), stk_ddzf, + & stk_qv, stk_ta, + & stk_uwind, stk_vwind, + & stk_zh, stk_zf, + & stk_presf, LSTK, LPBL, TSTK, WSTK, + & stk_DTHDZ, stk_WSPD ) + +C Trap USTAR at a minimum realistic value + USTMP = MAX1( Met_Data%USTAR(C, R ), 0.1 ) + +C Convert heat flux (watts/m2 to m K /s ) + HFLX = Met_Data%HFX( C,R ) / ( 1004.7642148 * Met_Data%DENS( C,R,1 ) ) + + CALL PLMRIS( EMLYRS, LSTK, HFLX, Met_Data%PBL(C,R), + & STKDM(N), STKHT(N), + & STKTK(N), STKVE( N ), + & TSTK, USTMP, + & stk_DTHDZ, stk_TA, + & stk_WSPD, stk_ZZF, + & stk_ZH, stk_ZSTK, + & WSTK, ZPLM ) + + if ( zplm .gt. mxzplm ) mxzplm = zplm + +C Default Turner approach. Plume thickness = amount of plume rise +C Plume rise DH = ZPLM minus the stack height STKHT + ZTOP = STKHT( N ) + & + 1.5 * ( ZPLM - STKHT( N ) ) + ZBOT = STKHT( N ) + & + 0.5 * ( ZPLM - STKHT( N ) ) + +C Set up for computing plume fractions, assuming uniform distribution in pressure +C (~mass concentration -- minor hydrostatic assumption) from bottom to top. + + IF ( ZTOP .LT. STKHT( N ) ) THEN + WRITE( LOGDEV,94010 ) 'ERROR: Top of plume is less than ' + & // 'top of stack for source:', N + WRITE( LOGDEV,* ) ' Zbot: ', ZBOT, ' Ztop: ', ZTOP + WRITE( LOGDEV,* ) ' Stack Top: ', STKHT( N ), + & ' Plume Top: ', ZPLM + stop + END IF + +C Compute LBOT, LTOP such that +C ZZF( LBOT-1 ) <= ZBOT < ZZF( LBOT ) and +C ZZF( LTOP-1 ) <= ZTOP < ZZF( LTOP ) + + DO L = 1, EMLYRS - 1 + IF ( ZBOT .LE. STK_ZZF( L ) ) THEN + LBOT = L + GO TO 122 + ELSE + TFRAC( L ) = 0.0 ! fractions below plume + END IF + END DO + LBOT = EMLYRS ! fallback + +122 CONTINUE ! loop exit: bottom found at LBOT + + IF ( ZTOP .LE. stk_ZZF( LBOT ) ) THEN ! plume in this layer + + TFRAC( LBOT ) = 1.0 + LTOP = LBOT + + DO L = LBOT + 1, EMLYRS ! fractions above plume + TFRAC( L ) = 0.0 + END DO + + ELSE IF ( LBOT .EQ. EMLYRS ) THEN ! plume above top layer + + TFRAC( LBOT ) = 1.0 + + DO L = 1, EMLYRS - 1 ! fractions below plume + TFRAC( L ) = 0.0 + END DO + + ELSE ! plume crosses layers + + DO L = LBOT + 1, EMLYRS + IF ( ZTOP .LE. STK_ZZF( L ) ) THEN + LTOP = L + GO TO 126 + END IF + END DO + LTOP = EMLYRS ! fallback + +126 CONTINUE + + ZDIFF = ZTOP - ZBOT + IF ( ZDIFF .GT. 0.0 ) THEN + DDZ = 1.0 / ZDIFF + TFRAC( LBOT ) = DDZ * ( stk_ZZF( LBOT ) - ZBOT ) + TFRAC( LTOP ) = DDZ * ( ZTOP - stk_ZZF( LTOP-1 ) ) + + ELSE ! ZDIFF .le. 0 + WRITE(logdev,* ) + & 'Infinitely small plume created for source:,' + & ,N,'All emissions put in first layer.' + LBOT = 1; LTOP = 1 + TFRAC( LBOT ) = 1.0 + END IF + + DO L = LBOT + 1, LTOP - 1 ! layers in plume + TFRAC( L ) = DDZ * ( stk_ZZF( L ) - stk_ZZF( L-1 ) ) + END DO + + DO L = LTOP + 1, EMLYRS ! fractions above plume + TFRAC( L ) = 0.0 + END DO + + END IF + +C If layer fractions are negative, put in the first layer + + IF ( MINVAL( TFRAC( 1:EMLYRS ) ) .LT. 0.0 ) THEN + WRITE( logdev,* ) 'WARNING: One or more negative plume ' + & // 'fractions found for source:' , N, 'Plume reset to ' + & // 'put all emissions in surface layer.' + TFRAC( 1 ) = 1.0 + TFRAC( 2:EMLYRS ) = 0.0 + END IF + +C Apportion emissions to the layers + + DO L = 1, EMLYRS + LFRC = TFRAC( L ) + IF ( LFRC .LE. 0.0 ) CYCLE + + DO V = 1, nvars_gc + I = indx_gc( V ) + VDEMIS_PT( C,R,L,I ) = VDEMIS_PT( C,R,L,I ) + LFRC * STKEM( J ) + & + LFRC * stkemis(n,V)/my_area (c,r) + END DO + DO V = 1, nvars_pm + I = indx_pm( V ) + PMEMIS_PT( C,R,L,I ) = PMEMIS_PT( C,R,L,I ) + & + LFRC * stkemis(n,V+nvars_gc)/my_area (c,r) ! emis fac applied in AERO_EMIS + END DO + + END DO + + + enddo ! end loop of nstack + +c-----FIRE emissions EM => AQM_EMIS_GET( ETYPE ) IF ( .NOT.ASSOCIATED( EM ) ) RETURN @@ -227,11 +625,6 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) WRITE( LOGDEV,* ) ' ' CALL M3MSG2( XMSG ) -C ... initialize emission arrays ... - - VDEMIS_PT = 0.0 ! array assignment - VDEMIS_PT_FIRE = 0.0 ! array assignment - PMEMIS_PT = 0.0 ! array assignment C ... initialize vertical fraction arrays ... C ... fire emissions are added to surface only by default ... @@ -296,7 +689,7 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) DO R = 1, MY_NROWS DO C = 1, MY_NCOLS K = K + 1 - VDEMIS_PT( C,R,L,N ) = VFRAC( C,R,L ) * BUFFER( K ) + VDEMIS_PT( C,R,L,N ) = VDEMIS_PT( C,R,L,N )+ VFRAC( C,R,L ) * BUFFER( K ) END DO END DO END DO @@ -306,7 +699,7 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) DO R = 1, MY_NROWS DO C = 1, MY_NCOLS K = K + 1 - VDEMIS_PT_FIRE( C,R,L,N ) = VDEMIS_PT( C,R,L,N ) + VDEMIS_PT_FIRE( C,R,L,N ) = VFRAC( C,R,L ) * BUFFER( K ) END DO END DO END DO @@ -316,8 +709,8 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) C ... aerosol species ... - DO S = 1, N_SPC_PTPM - V = PTPM_MAP( S ) + DO S = 1, N_SPC_PTPM ! FIRE inventory index of aerosol + V = PTPM_MAP( S ) ! index in aerosol emission holder BUFFER = 0.0 CALL AQM_EMIS_READ( ETYPE, PMEM_MAP_NAME( V ), BUFFER, RC=LOCALRC ) IF ( AQM_RC_CHECK( LOCALRC, MSG="Failure while reading " // @@ -328,14 +721,48 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) DO R = 1, MY_NROWS DO C = 1, MY_NCOLS K = K + 1 - PMEMIS_PT( C,R,L,S ) = VFRAC( C,R,L ) * BUFFER( K ) + PMEMIS_PT( C,R,L,S ) = PMEMIS_PT( C,R,L,S ) + VFRAC( C,R,L ) * BUFFER( K ) END DO END DO END DO END DO + +94010 FORMAT( 12( A, :, I8, :, 1X ) ) RETURN END SUBROUTINE GET_PT3D_EMIS + + function to_radian(degree) result(rad) + ! degrees to radians + real,intent(in) :: degree + real, parameter :: deg_to_rad = atan(1.0)/45 ! exploit intrinsic atan to generate pi/180 runtime constant + real :: rad + + rad = degree*deg_to_rad + end function to_radian + + function haversine(deglat1,deglon1,deglat2,deglon2) result (dist) + real,intent(in) :: deglat1,deglon1,deglat2,deglon2 + real :: a,c,dist,dlat,dlon,lat1,lat2 + real,parameter :: radius = 6372.8 ! in km + + dlat = to_radian(deglat2-deglat1) + dlon = to_radian(deglon2-deglon1) + lat1 = to_radian(deglat1) + lat2 = to_radian(deglat2) + a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 + c = 2*asin(sqrt(a)) + dist = radius*c + end function haversine + + subroutine check(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, 'netcdf error in PT3D_DEFN.F ', trim(nf90_strerror(status)) + stop "Stopped" + end if + end subroutine check END MODULE PT3D_DEFN diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index f4c4a8f..c660cf5 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -604,6 +604,8 @@ logical function interpx( fname, vname, pname, & select case (trim(vname)) case ('HT') p2d => stateIn % ht + case ('AREA') + p2d => stateIN % area case ('LAT') p2d => lat case ('LON') @@ -825,6 +827,10 @@ logical function interpx( fname, vname, pname, & end do end do end do + case ("UWINDA") + p3d => stateIn % uwind + case ("VWINDA") + p3d => stateIn % vwind case ("PRES") p3d => stateIn % prl case ("CFRAC_3D") From 203035553bff8fb84fca1966168134b951093b68 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Thu, 25 Aug 2022 21:01:06 +0000 Subject: [PATCH 40/72] Testing Sub-Canopy phot effects only. --- src/model/src/phot.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 86ad888..655f965 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1052,8 +1052,8 @@ END SUBROUTINE O3TOTCOL !Interpolate to get attenuation profile below canopy ZFL = Met_Data%ZF( COL,ROW,1 ) - ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy -! ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy +! ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy + ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy COUNTCAN = 0 ! Initialize canopy layers DO WHILE (ZCAN.GE.0.5) !canopy threshold >= 0.5 m IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN From 10b9b484353ac9d9e679ec4e1362a3308b90452d Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 14 Sep 2022 20:02:42 +0000 Subject: [PATCH 41/72] Enable CMAQ simplistic scavenging and wet removal in resolved clouds. --- CMakeLists.txt | 2 ++ aqm_files.cmake | 5 +++++ src/drv/cmaq_mod.F90 | 7 +++++++ src/shr/aqm_methods.F90 | 27 +++++++++++++++++++++++++++ 4 files changed, 41 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5fe78d8..b2a51ea 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -86,6 +86,8 @@ target_compile_definitions(CCTM PUBLIC SUBST_FILES_ID="FILES_CTM.EXT" SUBST_COMM=NOOP_COMM SUBST_BARRIER=NOOP_BARRIER SUBST_SUBGRID_INDEX=NOOP_SUBGRID_INDEX + AQ_MAP=DUMMY_AQ_MAP + CONVCLD_ACM=DUMMY_CONVCLD_ACM EDDYX=DUMMY_EDDYX MOSAIC_MOD=MOSAIC_MODULE Mosaic_Mod=Mosaic_Module diff --git a/aqm_files.cmake b/aqm_files.cmake index c3f7420..d4d5143 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -114,6 +114,11 @@ list(APPEND aqm_CCTM_files ${BIOG}/tmpbeis.F ${BIOG}/wrdaymsg.f ${CLOUD}/hlconst.F + ${CLOUD}/cldproc_acm.F + ${CLOUD}/getalpha.F + ${CLOUD}/indexn.f + ${CLOUD}/rescld.F + ${CLOUD}/scavwdep.F ${DEPV}/ABFLUX_MOD.F ${DEPV}/BIDI_MOD.F ${DEPV}/cgrid_depv.F diff --git a/src/drv/cmaq_mod.F90 b/src/drv/cmaq_mod.F90 index 8840434..9889e92 100644 --- a/src/drv/cmaq_mod.F90 +++ b/src/drv/cmaq_mod.F90 @@ -131,6 +131,11 @@ SUBROUTINE VDIFF ( CGRID, JDATE, JTIME, TSTEP ) INTEGER :: JDATE, JTIME INTEGER :: TSTEP( 3 ) END SUBROUTINE VDIFF + SUBROUTINE CLDPROC ( CGRID, JDATE, JTIME, TSTEP ) + REAL, POINTER :: CGRID( :,:,:,: ) + INTEGER, INTENT( IN ) :: JDATE, JTIME + INTEGER, INTENT( IN ) :: TSTEP( 3 ) + END SUBROUTINE CLDPROC SUBROUTINE CHEM ( CGRID, JDATE, JTIME, TSTEP ) REAL, POINTER :: CGRID( :,:,:,: ) INTEGER :: JDATE, JTIME @@ -151,6 +156,8 @@ END SUBROUTINE AERO CALL CHEM ( CGRID, JDATE, JTIME, TSTEP ) + CALL CLDPROC ( CGRID, JDATE, JTIME, TSTEP ) + if (run_aero) then CALL AERO ( CGRID, JDATE, JTIME, TSTEP ) end if diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index f4c4a8f..98f0e7f 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -1200,6 +1200,33 @@ END FUNCTION WRITE3_REAL4D ! -- dummy subroutines +SUBROUTINE DUMMY_AQ_MAP( JDATE, JTIME, WTBAR, WCBAR, TBARC, PBARC, & + CTHK1, AIRM, PRATE1, TAUCLD, POLC, CEND, & + REMOV, REMOVAC, ALFA0, ALFA2, ALFA3, DARK ) + INTEGER, INTENT( IN ) :: JDATE, JTIME + REAL, INTENT( IN ) :: WTBAR, WCBAR, TBARC, PBARC, & + CTHK1, AIRM, PRATE1, TAUCLD + REAL, INTENT( IN ) :: POLC ( : ) + REAL, INTENT( INOUT ) :: REMOVAC + REAL, INTENT( INOUT ) :: CEND( : ), REMOV( : ) + REAL, INTENT( IN ) :: ALFA0, ALFA2, ALFA3 + LOGICAL, INTENT( IN ) :: DARK +END SUBROUTINE DUMMY_AQ_MAP + +SUBROUTINE DUMMY_CONVCLD_ACM ( CGRID, JDATE, JTIME, TSTEP, & + N_SPC_WDEP, WDEP_MAP, CONV_DEP, SUBTRANS ) + REAL, POINTER :: CGRID( :,:,:,: ) + INTEGER, INTENT( IN ) :: JDATE + INTEGER, INTENT( IN ) :: JTIME + INTEGER, INTENT( IN ) :: TSTEP( 3 ) + INTEGER, INTENT( IN ) :: N_SPC_WDEP + INTEGER, INTENT( IN ) :: WDEP_MAP( : ) + REAL, INTENT( INOUT ) :: CONV_DEP( :,:,: ) + REAL, INTENT( OUT ) :: SUBTRANS( :,:,: ) + CONV_DEP = 0.0 + SUBTRANS = 0.0 +END SUBROUTINE DUMMY_CONVCLD_ACM + SUBROUTINE DUMMY_EDDYX ( EDDYV ) REAL, INTENT( OUT ) :: EDDYV ( :,:,: ) EDDYV = 0.0 From 9d67b9922db45e6ec5e1f8034fc8741db2a94f92 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 14 Sep 2022 20:41:13 +0000 Subject: [PATCH 42/72] Fix naming inconsistency for convective and nonconvective precipitation fields. --- src/shr/aqm_methods.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 98f0e7f..b3d5e65 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -155,7 +155,7 @@ LOGICAL FUNCTION DESC3( FNAME ) 'ZRUF ', & 'HFX ', 'WSPD10 ', & 'GSW ', 'RGRND ', & - 'RNA ', 'RCA ', & + 'RN ', 'RC ', & 'CFRAC ', 'CLDT ', & 'CLDB ', 'WBAR ', & 'RA ', 'RS ', & From ca5bcbc7e3e87765cf8825628249216177843589 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Wed, 14 Sep 2022 20:47:40 +0000 Subject: [PATCH 43/72] Properly set compiler flags in GNU build system for fixed source form files. --- src/io/ioapi/Makefile.am | 2 +- src/io/ioapi/Makefile.in | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io/ioapi/Makefile.am b/src/io/ioapi/Makefile.am index a708712..5676ec8 100644 --- a/src/io/ioapi/Makefile.am +++ b/src/io/ioapi/Makefile.am @@ -7,7 +7,7 @@ libioapi_a_SOURCES += crlf.F currec.f currstep.f dt2str.f findc.f getefile.F ind poly.f promptmfile.f sec2time.f secsdiff.F setlam.f sortic.f str2real.f time2sec.f upcase.f wkday.F yr2day.F libioapi_a_SOURCES += m3exit.F90 m3mesg.F90 m3msg2.F90 m3warn.F90 m3utilio.F90 -libioapi_a_FFLAGS = $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) +libioapi_a_FFLAGS = $(CCTM_FFLAGS) $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) libioapi_a_FCFLAGS = $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) libioapi_a_FCFLAGS += -DSUBST_FILES_ID=\"FILES_CTM.EXT\" diff --git a/src/io/ioapi/Makefile.in b/src/io/ioapi/Makefile.in index 1401c36..6d52ee3 100644 --- a/src/io/ioapi/Makefile.in +++ b/src/io/ioapi/Makefile.in @@ -326,7 +326,7 @@ libioapi_a_SOURCES = FDESC3.EXT PARMS3.EXT crlf.F currec.f currstep.f \ setlam.f sortic.f str2real.f time2sec.f upcase.f wkday.F \ yr2day.F m3exit.F90 m3mesg.F90 m3msg2.F90 m3warn.F90 \ m3utilio.F90 -libioapi_a_FFLAGS = $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) +libioapi_a_FFLAGS = $(CCTM_FFLAGS) $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) libioapi_a_FCFLAGS = $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) \ -DSUBST_FILES_ID=\"FILES_CTM.EXT\" -I \ From 1a083c880c3903966b4e801d4e68f9dd844f774a Mon Sep 17 00:00:00 2001 From: Youhua Tang Date: Tue, 20 Sep 2022 00:28:37 +0000 Subject: [PATCH 44/72] enable point source per DE --- src/aqm_cap.F90 | 3 +- src/model/src/PT3D_DEFN.F | 80 ++++++++++++++++++++++++++++----------- src/shr/aqm_rc_mod.F90 | 2 +- 3 files changed, 60 insertions(+), 25 deletions(-) diff --git a/src/aqm_cap.F90 b/src/aqm_cap.F90 index 5288d62..e97086a 100644 --- a/src/aqm_cap.F90 +++ b/src/aqm_cap.F90 @@ -378,12 +378,11 @@ subroutine DataInitialize(model, rc) return ! bail out end if - call ESMF_VMGet(vm, localPet=localPet, rc=rc) + call ESMF_VMGet(vm, localPet=mylocalPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - do localDe = 0, localDeCount-1 de = localDeToDeMap(localDe+1) + 1 tile = deToTileMap(de) diff --git a/src/model/src/PT3D_DEFN.F b/src/model/src/PT3D_DEFN.F index 3759b4c..f47352f 100644 --- a/src/model/src/PT3D_DEFN.F +++ b/src/model/src/PT3D_DEFN.F @@ -169,8 +169,8 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) USE AQM_EMIS_MOD USE AQM_FIRES_MOD USE AQM_RC_MOD -c use aqm_model_mod, only : aqm_config_type, aqm_state_type, -c & aqm_model_get, aqm_model_domain_get + use aqm_model_mod, only : aqm_config_type, aqm_state_type, + & aqm_model_get, aqm_model_domain_get USE RXNS_DATA, ONLY : MECHNAME !Get Chemical Mechanism Name USE GRID_CONF ! horizontal & vertical domain specifications @@ -178,7 +178,8 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) USE AERO_DATA, ONLY : N_EMIS_PM, PMEM_MAP_NAME USE PTMAP ! defines pt src species mapping to VDEMIS* arrays USE UTILIO_DEFN - + use esmf + use nuopc IMPLICIT NONE @@ -226,7 +227,11 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) INTEGER LSTK ! first L: ZF(L) > STKHT REAL LFRC ! intermediate LFRAC character(len=NF90_MAX_NAME) :: path_in - + + type(ESMF_VM) :: VM_ESMF + integer myrc, my_mpi_comm,my_ntasks, is, ie, js, je + character(200) :: aline + real zf0,zf1,mxzplm integer, save :: ntimes,itstep,ncid,iddim_stack,nstack,idvar,nvars,idlists(200), & id_em_gc(200),id_em_pm(200),indx_gc(200),indx_pm(200), nvars_gc,nvars_pm,ndims, @@ -296,11 +301,18 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height IF ( FIRSTIME ) THEN FIRSTIME = .FALSE. LOGDEV = SETUP_LOGDEV() + + call aqm_model_domain_get(ids=is, ide=ie, jds=js, jde=je, rc=myrc) + if (aqm_rc_check(myrc, msg="Failure to retrieve grid coordinates in PT3D", + & file=__FILE__, line=__LINE__)) return - L=nf90_open('NEXUS/PT.nc',nf90_nowrite, ncid) + write(logdev,*)'LOCALPET, is, ie, js, je=',mylocalpet, is, ie, js, je + write(aline,"('PT/pt-',i4.4,'.nc')")mylocalpet + L=nf90_open(trim(aline),nf90_nowrite, ncid) if(L.ne.nf90_noerr) then - write(logdev,*)'error openning NEXUS/PT.nc' - stop + IF ( AQM_RC_CHECK( L, + & MSG='failed to open '//trim(aline), + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif call check(nf90_inq_dimid(ncid,'nlocs',iddim_stack)) call check(nf90_inquire_dimension(ncid,iddim_stack,len=nstack)) @@ -347,7 +359,9 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height if(ndims.ne.2) then write(logdev,*)'ndims wrong',ndims,vname - stop + IF ( AQM_RC_CHECK( 1, + & MSG='gaseous ndims wrong '//trim(vname), + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif if( PTEM_MAP( L ) .gt.0) then nvars_gc=nvars_gc+1 @@ -360,7 +374,9 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height if (L > 0) then if(ndims.ne.2) then write(logdev,*)'ndims wrong',ndims,vname - stop + IF ( AQM_RC_CHECK( 1, + & MSG='aerosol ndims wrong '//trim(vname), + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif do S=1, N_SPC_PTPM if(PTPM_MAP(S).eq.L) exit @@ -374,10 +390,14 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height endif enddo - write(logdev,*)'Point Sources nvars_gc, nvars_pm=',nvars_gc, nvars_pm + write(logdev,*)'Point Sources nstack, nvars_gc, nvars_pm=',nstack,nvars_gc, nvars_pm write(logdev,*)'ncols,nrows,my_ncols,my_nrows=',ncols,nrows,my_ncols,my_nrows allocate(my_area(my_ncols,my_nrows)) - if(.not.interpx(GRID_CRO_2D,'AREA','emis',1,my_ncols,1,my_nrows,1,1,jdate,jtime,my_area)) stop + if(.not.interpx(GRID_CRO_2D,'AREA','emis',1,my_ncols,1,my_nrows,1,1,jdate,jtime,my_area)) then + IF ( AQM_RC_CHECK( 1, + & MSG='failed to get area '//trim(aline), + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN + endif allocate(stkemis(nstack,nvars_gc+nvars_pm),uwind(my_ncols,my_nrows,emlyrs), vwind(my_ncols,my_nrows,emlyrs), & stk_ddzf(emlyrs),stk_pres(emlyrs),stk_dens(emlyrs),stk_qv(emlyrs),stk_ta(emlyrs),stk_wspd(emlyrs),stk_zf(emlyrs), @@ -398,12 +418,13 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height C--- anthropogenic point sources itstep=secsdiff(jstartdate,jstarttime,jdate,jtime)/3600+1 - write(logdev,*)'process PT emission ',jdate,jtime,tstep(1),itstep + write(logdev,*)'process PT emission ',jdate,jtime,tstep(1),itstep, mylocalpet,nstack n=nf90_inq_path(ncid,L,path_in) - if(n.ne.nf90_noerr.or.trim(path_in).ne.'NEXUS/PT.nc') then - write(logdev,*)itstep,'ncid wrong, reopen it ',trim(nf90_strerror(n)) - L=nf90_close(ncid) - call check(nf90_open('NEXUS/PT.nc',nf90_nowrite, ncid)) + if(n.ne.nf90_noerr) then + write(logdev,*)itstep,'ncid wrong ',trim(nf90_strerror(n)) + IF ( AQM_RC_CHECK( 1, + & MSG='ncid wrong ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif elemStart(1)=1; elemStart(2)=itstep @@ -418,8 +439,10 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height write(logdev,*)'also error 1-step reading PT emission of gas ',v,trim(nf90_strerror(S)),id_em_gc(v) else write(logdev,*)'OK for 1-step reading PT emission of gas ',v,trim(nf90_strerror(S)),id_em_gc(v) - endif - stop + endif + IF ( AQM_RC_CHECK( 1, + & MSG='failed to read PT gas emission ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif enddo @@ -428,13 +451,23 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height L=nf90_get_var(ncid,id_em_pm(v),stkemis(:,v+nvars_gc),start=elemStart,count=elemCount) if(L.ne.nf90_noerr) then write(logdev,*)'error reading PT emission of pm ',v,itstep,nstack,id_em_pm(v) - stop + IF ( AQM_RC_CHECK( 1, + & MSG='failed to read PT aerosol emission ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN endif enddo c call check(nf90_close(ncid)) - if(.not.interpx(MET_CRO_3D,'UWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,uwind)) stop - if(.not.interpx(MET_CRO_3D,'VWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,vwind)) stop + if(.not.interpx(MET_CRO_3D,'UWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,uwind)) then + IF ( AQM_RC_CHECK( 1, + & MSG='failed to read wind field ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN + endif + if(.not.interpx(MET_CRO_3D,'VWINDA','PT3D_DEFN',1,my_ncols,1,my_nrows,1,emlyrs,jdate,jtime,vwind)) then + IF ( AQM_RC_CHECK( 1, + & MSG='failed to read wind field ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN + endif mxzplm=0.0 @@ -509,7 +542,10 @@ END SUBROUTINE PLMRIS ! temporarily, plume top height WRITE( LOGDEV,* ) ' Zbot: ', ZBOT, ' Ztop: ', ZTOP WRITE( LOGDEV,* ) ' Stack Top: ', STKHT( N ), & ' Plume Top: ', ZPLM - stop + IF ( AQM_RC_CHECK( 1, + & MSG='ERROR: Top of plume is less than stack height ', + & FILE=__FILE__, LINE=__LINE__ ) ) RETURN + END IF C Compute LBOT, LTOP such that diff --git a/src/shr/aqm_rc_mod.F90 b/src/shr/aqm_rc_mod.F90 index 1f9496b..96ba736 100644 --- a/src/shr/aqm_rc_mod.F90 +++ b/src/shr/aqm_rc_mod.F90 @@ -4,7 +4,7 @@ module aqm_rc_mod integer, parameter :: AQM_RC_SUCCESS = 0 integer, parameter :: AQM_RC_FAILURE = -1 - + integer :: mylocalpet public contains From 2939b88b96993bf17a86986f2eae43f56e13bbbe Mon Sep 17 00:00:00 2001 From: Youhua Tang Date: Fri, 30 Sep 2022 13:03:17 +0000 Subject: [PATCH 45/72] minor update --- src/model/src/ASX_DATA_MOD.F | 0 src/model/src/PT3D_DEFN.F | 6 +++--- 2 files changed, 3 insertions(+), 3 deletions(-) mode change 100755 => 100644 src/model/src/ASX_DATA_MOD.F diff --git a/src/model/src/ASX_DATA_MOD.F b/src/model/src/ASX_DATA_MOD.F old mode 100755 new mode 100644 diff --git a/src/model/src/PT3D_DEFN.F b/src/model/src/PT3D_DEFN.F index f47352f..3dd8aca 100644 --- a/src/model/src/PT3D_DEFN.F +++ b/src/model/src/PT3D_DEFN.F @@ -178,8 +178,8 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) USE AERO_DATA, ONLY : N_EMIS_PM, PMEM_MAP_NAME USE PTMAP ! defines pt src species mapping to VDEMIS* arrays USE UTILIO_DEFN - use esmf - use nuopc +! use esmf +! use nuopc IMPLICIT NONE @@ -228,7 +228,7 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) REAL LFRC ! intermediate LFRAC character(len=NF90_MAX_NAME) :: path_in - type(ESMF_VM) :: VM_ESMF +! type(ESMF_VM) :: VM_ESMF integer myrc, my_mpi_comm,my_ntasks, is, ie, js, je character(200) :: aline From 71ebc0af939319f97e9369e25961c2643461bcef Mon Sep 17 00:00:00 2001 From: zmoon Date: Wed, 26 Oct 2022 10:50:11 -0600 Subject: [PATCH 46/72] Wet deposition fix from @rmontuoro based on the current diff of /scratch2/NCEPDEV/naqfc/Raffaele.Montuoro/flux/dev/pr/jianping/dev/ufs-weather-model/AQM/src/shr/aqm_methods.F90 (couldn't just copy the file since we have other changes) --- src/shr/aqm_methods.F90 | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 0c7818d..4dc7165 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -76,7 +76,7 @@ LOGICAL FUNCTION DESC3( FNAME ) USE M3UTILIO, ONLY : & GDNAM3D, NLAYS3D, NVARS3D, VDESC3D, VGLVS3D, & VGSGPN3, VGTOP3D, VGTYP3D, VNAME3D, UNITS3D, & - NCOLS3D, NROWS3D + NCOLS3D, NROWS3D, SDATE3D, STIME3D, TSTEP3D USE aqm_emis_mod USE aqm_model_mod, ONLY : aqm_config_type, & @@ -198,6 +198,14 @@ LOGICAL FUNCTION DESC3( FNAME ) '1 ', '1 ', & '1 ', 'M/S ' /) + call aqm_model_get(config=config, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & + file=__FILE__, line=__LINE__)) return + + SDATE3D = config % ctm_stdate + STIME3D = config % ctm_sttime + TSTEP3D = config % ctm_tstep + ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN CALL aqm_model_domain_get(nl=NLAYS3D, rc=localrc) @@ -236,6 +244,10 @@ LOGICAL FUNCTION DESC3( FNAME ) if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return + SDATE3D = config % ctm_stdate + STIME3D = config % ctm_sttime + TSTEP3D = config % ctm_tstep + if (config % species % p_atm_qr > 0) then NVARS3D = NVARS3D + 1 VNAME3D( NVARS3D ) = 'QR' @@ -278,6 +290,14 @@ LOGICAL FUNCTION DESC3( FNAME ) (/ 'M/S ', 'M/S ', & 'KG/(M*S) ', 'KG/(M*S) ' /) + call aqm_model_get(config=config, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & + file=__FILE__, line=__LINE__)) return + + SDATE3D = config % ctm_stdate + STIME3D = config % ctm_sttime + TSTEP3D = config % ctm_tstep + DESC3 = .TRUE. RETURN @@ -728,6 +748,14 @@ logical function interpx( fname, vname, pname, & p2d => stateIn % fice case ("SLTYP") p2d => stateIn % stype + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + buffer(k) = stateIn % stype(c,r) + if (buffer(k) <= 0.) buffer(k) = 99. + end do + end do case ("SNOCOV") p2d => stateIn % sncov case ("SOIM1") From 6b496a2e458eb96efb78f96768189e0bb94360fa Mon Sep 17 00:00:00 2001 From: zmoon Date: Thu, 17 Nov 2022 11:43:31 -0700 Subject: [PATCH 47/72] Revert "Wet deposition fix from @rmontuoro" This reverts commit 71ebc0af939319f97e9369e25961c2643461bcef. So that we can merge the official version more easily --- src/shr/aqm_methods.F90 | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 4dc7165..0c7818d 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -76,7 +76,7 @@ LOGICAL FUNCTION DESC3( FNAME ) USE M3UTILIO, ONLY : & GDNAM3D, NLAYS3D, NVARS3D, VDESC3D, VGLVS3D, & VGSGPN3, VGTOP3D, VGTYP3D, VNAME3D, UNITS3D, & - NCOLS3D, NROWS3D, SDATE3D, STIME3D, TSTEP3D + NCOLS3D, NROWS3D USE aqm_emis_mod USE aqm_model_mod, ONLY : aqm_config_type, & @@ -198,14 +198,6 @@ LOGICAL FUNCTION DESC3( FNAME ) '1 ', '1 ', & '1 ', 'M/S ' /) - call aqm_model_get(config=config, rc=localrc) - if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & - file=__FILE__, line=__LINE__)) return - - SDATE3D = config % ctm_stdate - STIME3D = config % ctm_sttime - TSTEP3D = config % ctm_tstep - ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN CALL aqm_model_domain_get(nl=NLAYS3D, rc=localrc) @@ -244,10 +236,6 @@ LOGICAL FUNCTION DESC3( FNAME ) if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return - SDATE3D = config % ctm_stdate - STIME3D = config % ctm_sttime - TSTEP3D = config % ctm_tstep - if (config % species % p_atm_qr > 0) then NVARS3D = NVARS3D + 1 VNAME3D( NVARS3D ) = 'QR' @@ -290,14 +278,6 @@ LOGICAL FUNCTION DESC3( FNAME ) (/ 'M/S ', 'M/S ', & 'KG/(M*S) ', 'KG/(M*S) ' /) - call aqm_model_get(config=config, rc=localrc) - if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & - file=__FILE__, line=__LINE__)) return - - SDATE3D = config % ctm_stdate - STIME3D = config % ctm_sttime - TSTEP3D = config % ctm_tstep - DESC3 = .TRUE. RETURN @@ -748,14 +728,6 @@ logical function interpx( fname, vname, pname, & p2d => stateIn % fice case ("SLTYP") p2d => stateIn % stype - k = 0 - do r = row0, row1 - do c = col0, col1 - k = k + 1 - buffer(k) = stateIn % stype(c,r) - if (buffer(k) <= 0.) buffer(k) = 99. - end do - end do case ("SNOCOV") p2d => stateIn % sncov case ("SOIM1") From 5ac639d9747fb97cf3ddf4dd000dd1e5f6b38b20 Mon Sep 17 00:00:00 2001 From: zmoon Date: Fri, 13 Jan 2023 15:27:38 -0700 Subject: [PATCH 48/72] Fix merge bug duplicate cases in select --- src/shr/aqm_methods.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 931fcdb..93c3b25 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -928,10 +928,6 @@ logical function interpx( fname, vname, pname, & end do end do end do - case ("UWINDA") - p3d => stateIn % uwind - case ("VWINDA") - p3d => stateIn % vwind case ("PRES") p3d => stateIn % prl case ("PRESF") From 4861c202a9495bae65e8d2774942b8146277b9f0 Mon Sep 17 00:00:00 2001 From: zmoon Date: Fri, 13 Jan 2023 15:42:49 -0700 Subject: [PATCH 49/72] Remove leftover code in PT3D_DEFN from the initial PT impl --- src/model/src/PT3D_DEFN.F | 32 -------------------------------- 1 file changed, 32 deletions(-) diff --git a/src/model/src/PT3D_DEFN.F b/src/model/src/PT3D_DEFN.F index 2497553..0a7163d 100644 --- a/src/model/src/PT3D_DEFN.F +++ b/src/model/src/PT3D_DEFN.F @@ -118,37 +118,5 @@ SUBROUTINE GET_PT3D_EMIS ( JDATE, JTIME, TSTEP ) CALL GET_PT3D_STKS_EMIS ( JDATE, JTIME ) END SUBROUTINE GET_PT3D_EMIS - - function to_radian(degree) result(rad) - ! degrees to radians - real,intent(in) :: degree - real, parameter :: deg_to_rad = atan(1.0)/45 ! exploit intrinsic atan to generate pi/180 runtime constant - real :: rad - - rad = degree*deg_to_rad - end function to_radian - - function haversine(deglat1,deglon1,deglat2,deglon2) result (dist) - real,intent(in) :: deglat1,deglon1,deglat2,deglon2 - real :: a,c,dist,dlat,dlon,lat1,lat2 - real,parameter :: radius = 6372.8 ! in km - - dlat = to_radian(deglat2-deglat1) - dlon = to_radian(deglon2-deglon1) - lat1 = to_radian(deglat1) - lat2 = to_radian(deglat2) - a = (sin(dlat/2))**2 + cos(lat1)*cos(lat2)*(sin(dlon/2))**2 - c = 2*asin(sqrt(a)) - dist = radius*c - end function haversine - - subroutine check(status) - integer, intent ( in) :: status - - if(status /= nf90_noerr) then - print *, 'netcdf error in PT3D_DEFN.F ', trim(nf90_strerror(status)) - stop "Stopped" - end if - end subroutine check END MODULE PT3D_DEFN From f72f8e96cfb4d8299cd465d5825d185d70c59ccf Mon Sep 17 00:00:00 2001 From: zmoon Date: Wed, 18 Jan 2023 19:46:03 -0700 Subject: [PATCH 50/72] Remove duplicate (and non-guarded) `CLDPROC` call seems was leftover when the new guarded one was merged in --- src/drv/cmaq_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/drv/cmaq_mod.F90 b/src/drv/cmaq_mod.F90 index 90f7a3b..ac47610 100644 --- a/src/drv/cmaq_mod.F90 +++ b/src/drv/cmaq_mod.F90 @@ -165,8 +165,6 @@ END SUBROUTINE AERO CALL CHEM ( CGRID, JDATE, JTIME, TSTEP ) - CALL CLDPROC ( CGRID, JDATE, JTIME, TSTEP ) - if (run_aero) then CALL AERO ( CGRID, JDATE, JTIME, TSTEP ) end if From 754c7e6e478bfb3e4035e8df62cca51b9300e61d Mon Sep 17 00:00:00 2001 From: zmoon Date: Wed, 18 Jan 2023 19:52:43 -0700 Subject: [PATCH 51/72] style reduce diff wrt. upstream --- src/shr/aqm_methods.F90 | 3 +-- src/shr/aqm_state_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index 93c3b25..ec0dab0 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -821,7 +821,7 @@ logical function interpx( fname, vname, pname, & k = k + 1 buffer(k) = 0.01 * stateIn % zorl(c,r) end do - end do + end do case ("CLAYF","DRAG","SANDF","UTHR") ! -- fengsha variables call aqm_emis_read("fengsha", vname, buffer, rc=localrc) @@ -838,7 +838,6 @@ logical function interpx( fname, vname, pname, & else buffer(1:lbuf) = 0. end if - case default ! return end select diff --git a/src/shr/aqm_state_mod.F90 b/src/shr/aqm_state_mod.F90 index 1f2d87f..0dff89d 100644 --- a/src/shr/aqm_state_mod.F90 +++ b/src/shr/aqm_state_mod.F90 @@ -59,7 +59,7 @@ module aqm_state_mod ! -- diagnostics real(AQM_KIND_R8), dimension(:,:), pointer :: aod => null() - + end type aqm_state_type public From 3fef8af9246c54b1e78f24287a9ad786ff8bca77 Mon Sep 17 00:00:00 2001 From: zmoon Date: Wed, 18 Jan 2023 19:58:54 -0700 Subject: [PATCH 52/72] Remove duplicate get-config in `aqm_methods` --- src/shr/aqm_methods.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index ec0dab0..d5b8e1f 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -722,11 +722,6 @@ logical function interpx( fname, vname, pname, & if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return - call aqm_model_get(config=config, stateIn=stateIn, rc=localrc) - if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & - file=__FILE__, line=__LINE__)) return - - select case (trim(vname)) case ("HFX") p2d => stateIn % hfx From a1cf98c42e2744637b9240564c73f0f4dacf8baf Mon Sep 17 00:00:00 2001 From: zmoon Date: Wed, 18 Jan 2023 20:02:58 -0700 Subject: [PATCH 53/72] Remove 'AREA' case in `interpx` was added by Youhua but is not present in upstream --- src/shr/aqm_methods.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index d5b8e1f..a3c8787 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -679,8 +679,6 @@ logical function interpx( fname, vname, pname, & select case (trim(vname)) case ('HT') p2d => stateIn % ht - case ('AREA') - p2d => stateIN % area case ('LAT') p2d => lat case ('LON') From c7992a2325d0e1bd650e0297b437cbb310d78634 Mon Sep 17 00:00:00 2001 From: zmoon Date: Thu, 19 Jan 2023 09:17:01 -0700 Subject: [PATCH 54/72] Remove fenghsa `em%dens_flag` block upstream doesn't have it --- src/shr/aqm_emis_mod.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/shr/aqm_emis_mod.F90 b/src/shr/aqm_emis_mod.F90 index ad902e7..711264d 100644 --- a/src/shr/aqm_emis_mod.F90 +++ b/src/shr/aqm_emis_mod.F90 @@ -1606,12 +1606,6 @@ subroutine aqm_emis_grd_read(em, spcname, buffer, localDe, rc) em % dens_flag(item) = 1 end if - if (trim(em % type) == "fengsha") then - ! -- ensure fengsha input variables are not normalized by area like - ! -- emissions conversions below - em % dens_flag(item) = 1 - end if - select case (em % dens_flag(item)) case (:-1) ! -- this case indicates that input emissions are provided as totals/cell From 25119722e6647882a21f7f2468ccece4b209f23c Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Mon, 23 Jan 2023 11:34:24 -0500 Subject: [PATCH 55/72] Uncommenting diagnostic prints phot.F Quick check of canopy inputs and photolysis attenuation factors. --- src/model/src/phot.F | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 655f965..2885252 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1017,11 +1017,11 @@ END SUBROUTINE O3TOTCOL !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) -! WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , -! & 'FCH = ', Met_Data%FCH( COL,ROW ), -! & 'FRT = ', Met_Data%FRT( COL,ROW), -! & 'POPU = ', Met_Data%POPU( COL,ROW), -! & 'CLU = ', Met_Data%CLU( COL,ROW) + WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , + & 'FCH = ', Met_Data%FCH( COL,ROW ), + & 'FRT = ', Met_Data%FRT( COL,ROW), + & 'POPU = ', Met_Data%POPU( COL,ROW), + & 'CLU = ', Met_Data%CLU( COL,ROW) !conditions for grid cells that do NOT have !a continuous forest canopy @@ -1119,9 +1119,9 @@ END SUBROUTINE O3TOTCOL !Integrate to get best attenuation value to use within canopy RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL -! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), -! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), -! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) + WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), + & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), + & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) !Apply attenuation factors above and below canopy RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values From b4808e887ca9a4bcbba0c208fd50e08e566f1354 Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Mon, 23 Jan 2023 12:18:26 -0500 Subject: [PATCH 56/72] Update phot.F --- src/model/src/phot.F | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 2885252..655f965 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1017,11 +1017,11 @@ END SUBROUTINE O3TOTCOL !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) - WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , - & 'FCH = ', Met_Data%FCH( COL,ROW ), - & 'FRT = ', Met_Data%FRT( COL,ROW), - & 'POPU = ', Met_Data%POPU( COL,ROW), - & 'CLU = ', Met_Data%CLU( COL,ROW) +! WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , +! & 'FCH = ', Met_Data%FCH( COL,ROW ), +! & 'FRT = ', Met_Data%FRT( COL,ROW), +! & 'POPU = ', Met_Data%POPU( COL,ROW), +! & 'CLU = ', Met_Data%CLU( COL,ROW) !conditions for grid cells that do NOT have !a continuous forest canopy @@ -1119,9 +1119,9 @@ END SUBROUTINE O3TOTCOL !Integrate to get best attenuation value to use within canopy RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL - WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), - & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), - & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) +! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), +! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), +! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) !Apply attenuation factors above and below canopy RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values From d577615112f6371b6e108779715350341aa770ff Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Tue, 24 Jan 2023 10:41:39 -0500 Subject: [PATCH 57/72] Update phot.F Fixed bug on integrating though ZCAN=ZFL, and rolled back to FCH > 0.5 m canopy condition to be consistent with initial implementation. --- src/model/src/phot.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 655f965..9afa062 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1026,8 +1026,8 @@ END SUBROUTINE O3TOTCOL !conditions for grid cells that do NOT have !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 -! & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 + & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 +! & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 @@ -1052,8 +1052,8 @@ END SUBROUTINE O3TOTCOL !Interpolate to get attenuation profile below canopy ZFL = Met_Data%ZF( COL,ROW,1 ) -! ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy - ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy + ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy +! ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy COUNTCAN = 0 ! Initialize canopy layers DO WHILE (ZCAN.GE.0.5) !canopy threshold >= 0.5 m IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN From 6d4fc2732fdb02f33c7d262dc4c5f934e5f722f5 Mon Sep 17 00:00:00 2001 From: Patrick Campbell Date: Tue, 24 Jan 2023 10:42:35 -0500 Subject: [PATCH 58/72] Update phot.F Fixed bug on integrating though ZCAN=ZFL, and rolled back to FCH > 0.5 m canopy condition to be consistent with initial implementation. --- src/model/src/phot.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 655f965..9afa062 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1026,8 +1026,8 @@ END SUBROUTINE O3TOTCOL !conditions for grid cells that do NOT have !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 -! & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 + & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 +! & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 @@ -1052,8 +1052,8 @@ END SUBROUTINE O3TOTCOL !Interpolate to get attenuation profile below canopy ZFL = Met_Data%ZF( COL,ROW,1 ) -! ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy - ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy + ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy +! ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy COUNTCAN = 0 ! Initialize canopy layers DO WHILE (ZCAN.GE.0.5) !canopy threshold >= 0.5 m IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN From db3e48d08006e4626fb71f88996820c3110e2bf3 Mon Sep 17 00:00:00 2001 From: Brian Curtis <64433609+BrianCurtis-NOAA@users.noreply.github.com> Date: Tue, 7 Feb 2023 15:46:25 -0500 Subject: [PATCH 59/72] Revert fixes to get debug mode working with UFSWM debug run (#57) --- aqm_files.cmake | 2 +- src/model/src/vdiffacmx.F | 58 +++++++++++++++++---------------------- 2 files changed, 26 insertions(+), 34 deletions(-) diff --git a/aqm_files.cmake b/aqm_files.cmake index 67709fd..692c7d0 100644 --- a/aqm_files.cmake +++ b/aqm_files.cmake @@ -87,6 +87,7 @@ set(VDIFF "${CCTM_ROOT}/vdiff/acm2") set(localCCTM "src/model/src") list(APPEND aqm_CCTM_files ${AERO}/AERO_DATA.F + ${AERO}/aero_depv.F ${AERO}/aero_driver.F ${AERO}/AERO_EMIS.F ${AERO}/AEROMET_DATA.F @@ -242,5 +243,4 @@ list(APPEND aqm_CCTM_files ${localCCTM}/ASX_DATA_MOD.F ${localCCTM}/DUST_EMIS.F ${localCCTM}/AERO_PHOTDATA.F - ${localCCTM}/aero_depv.F ) diff --git a/src/model/src/vdiffacmx.F b/src/model/src/vdiffacmx.F index 1cdb48e..06954c4 100644 --- a/src/model/src/vdiffacmx.F +++ b/src/model/src/vdiffacmx.F @@ -65,19 +65,19 @@ SUBROUTINE VDIFFACMX ( DTSEC, SEDDY, DDEP, ICMP, DDEPJ, DDEPJ_FST, CNGRD ) CHARACTER( 120 ) :: XMSG = ' ' C Arguments: - REAL*8, INTENT( IN ) :: DTSEC ! model time step in seconds + REAL, INTENT( IN ) :: DTSEC ! model time step in seconds C--- SEDDY is strictly an input, but it gets modified here - REAL*8, INTENT( INOUT ) :: SEDDY ( :,:,: ) ! flipped EDDYV - REAL*8, INTENT( INOUT ) :: DDEP ( :,:,: ) ! ddep accumulator - REAL*8, INTENT( INOUT ) :: ICMP ( :,:,: ) ! component flux accumlator - REAL*8, INTENT( INOUT ), OPTIONAL :: DDEPJ ( :,:,:,: ) ! ddep for mosaic - REAL*8, INTENT( INOUT ), OPTIONAL :: DDEPJ_FST( :,:,:,: ) ! ddep for stomtal/cuticular pathway + REAL, INTENT( INOUT ) :: SEDDY ( :,:,: ) ! flipped EDDYV + REAL, INTENT( INOUT ) :: DDEP ( :,:,: ) ! ddep accumulator + REAL, INTENT( INOUT ) :: ICMP ( :,:,: ) ! component flux accumlator + REAL, INTENT( INOUT ), OPTIONAL :: DDEPJ ( :,:,:,: ) ! ddep for mosaic + REAL, INTENT( INOUT ), OPTIONAL :: DDEPJ_FST( :,:,:,: ) ! ddep for stomtal/cuticular pathway REAL, INTENT( INOUT ) :: CNGRD ( :,:,:,: ) ! cgrid replacement C Parameters: C explicit, THETA = 0, implicit, THETA = 1 ! Crank-Nicholson: THETA = 0.5 - REAL*8, PARAMETER :: THETA = 0.5, + REAL, PARAMETER :: THETA = 0.5, & THBAR = 1.0 - THETA C External Functions: None @@ -88,26 +88,26 @@ SUBROUTINE VDIFFACMX ( DTSEC, SEDDY, DDEP, ICMP, DDEPJ, DDEPJ_FST, CNGRD ) LOGICAL, SAVE :: FIRSTIME = .TRUE. - REAL*8, ALLOCATABLE, SAVE :: DD_FAC ( : ) ! combined subexpression - REAL*8, ALLOCATABLE, SAVE :: DDBF ( : ) ! secondary DDEP - REAL*8, ALLOCATABLE, SAVE :: CMPF ( : ) ! intermediate CMP - REAL*8, ALLOCATABLE, SAVE :: CONC ( :,: ) ! secondary CGRID expression - REAL*8, ALLOCATABLE, SAVE :: EMIS ( :,: ) ! emissions subexpression - REAL*8 DTDENS1 ! DT * layer 1 air density + REAL, ALLOCATABLE, SAVE :: DD_FAC ( : ) ! combined subexpression + REAL, ALLOCATABLE, SAVE :: DDBF ( : ) ! secondary DDEP + REAL, ALLOCATABLE, SAVE :: CMPF ( : ) ! intermediate CMP + REAL, ALLOCATABLE, SAVE :: CONC ( :,: ) ! secondary CGRID expression + REAL, ALLOCATABLE, SAVE :: EMIS ( :,: ) ! emissions subexpression + REAL DTDENS1 ! DT * layer 1 air density C ACM Local Variables - REAL*8 DFACP, DFACQ - REAL*8 RP, RQ - REAL*8, ALLOCATABLE, SAVE :: DEPVCR ( : ) ! dep vel in one cell - REAL*8, ALLOCATABLE, SAVE :: EFAC1 ( : ) - REAL*8, ALLOCATABLE, SAVE :: EFAC2 ( : ) - REAL*8, ALLOCATABLE, SAVE :: POL ( : ) ! prodn/lossrate = PLDV/DEPV - REAL*8 PLDV_HONO ! PLDV for HONO - REAL*8 DEPV_NO2 ! dep vel of NO2 - REAL*8 DEPV_HNO3 ! dep vel of HNO3 + REAL DFACP, DFACQ + REAL RP, RQ + REAL, ALLOCATABLE, SAVE :: DEPVCR ( : ) ! dep vel in one cell + REAL, ALLOCATABLE, SAVE :: EFAC1 ( : ) + REAL, ALLOCATABLE, SAVE :: EFAC2 ( : ) + REAL, ALLOCATABLE, SAVE :: POL ( : ) ! prodn/lossrate = PLDV/DEPV + REAL PLDV_HONO ! PLDV for HONO + REAL DEPV_NO2 ! dep vel of NO2 + REAL DEPV_HNO3 ! dep vel of HNO3 INTEGER, SAVE :: NO2_HIT, HONO_HIT, HNO3_HIT, NO2_MAP, HNO3_MAP INTEGER, SAVE :: NH3_HIT - REAL*8 DTS + REAL DTS INTEGER, SAVE :: LOGDEV INTEGER ASTAT @@ -222,11 +222,7 @@ SUBROUTINE VDIFFACMX ( DTSEC, SEDDY, DDEP, ICMP, DDEPJ, DDEPJ_FST, CNGRD ) IF ( V .EQ. HNO3_HIT ) THEN S = HNO3_MAP CONC( S,1 ) = POL( V ) + ( CONC( S,1 ) - POL( V ) ) * EFAC1( V ) - IF (CONC( NO2_MAP,1 ) .NE. 0) THEN - DEPV_HNO3 = DEPVCR( V ) + PLDV_HONO / CONC( NO2_MAP,1 ) - ELSE - DEPV_HNO3 = DEPVCR( V ) - END IF + DEPV_HNO3 = DEPVCR( V ) + PLDV_HONO / CONC( NO2_MAP,1 ) DD_FAC( V ) = DTDENS1 * DD_CONV( V ) * DEPV_HNO3 DDBF( V ) = DDBF( V ) + THETA * DD_FAC( V ) * CONC( S,1 ) @@ -237,11 +233,7 @@ SUBROUTINE VDIFFACMX ( DTSEC, SEDDY, DDEP, ICMP, DDEPJ, DDEPJ_FST, CNGRD ) C reduce the NO2 conc. in the atmosphere without affecting the depositional loss. ELSE IF ( V .EQ. NO2_HIT ) THEN S = NO2_MAP - IF (CONC( S,1 ) .NE. 0) THEN - DEPV_NO2 = DEPVCR( V ) + 2.0 * PLDV_HONO / CONC( S,1 ) - ELSE - DEPV_NO2 = DEPVCR( V ) - END IF + DEPV_NO2 = DEPVCR( V ) + 2.0 * PLDV_HONO / CONC( S,1 ) EFAC1 ( V ) = EXP( -DEPV_NO2 * RP ) EFAC2 ( V ) = EXP( -DEPV_NO2 * RQ ) POL ( V ) = PLDV( V,C,R ) / DEPV_NO2 From ebe14d58bc78bf67a1fd1a3efdf27dfb613dc64e Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Fri, 10 Feb 2023 12:50:36 -0500 Subject: [PATCH 60/72] Restricted to FCH and LAI only to match CCPP physics. --- src/model/src/phot.F | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 9afa062..e621104 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1027,11 +1027,12 @@ END SUBROUTINE O3TOTCOL !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 +! Only using LAI and FCH conditions now consistent with CCPP PBL ! & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 - & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 - & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 - & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 - & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN +! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 +! & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 +! & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 +! & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, :) ELSE ! There is a contiguous forest canopy,apply correctoin !RJ_CORR effectly represents the beam attenuation and reduces photolysis. From 61ce18a0a3881c871e8ea93333a80048426499c8 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Fri, 10 Feb 2023 13:01:46 -0500 Subject: [PATCH 61/72] Fixed bug in IF statement for canopy conditions. --- src/model/src/phot.F | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index e621104..99862a3 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1026,8 +1026,7 @@ END SUBROUTINE O3TOTCOL !conditions for grid cells that do NOT have !a continuous forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 -! Only using LAI and FCH conditions now consistent with CCPP PBL + & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 ) THEN ! & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 ! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 ! & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 From 63d92cccd5f33ad2a41bcaf2db1b2a1a5b91223a Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Thu, 23 Mar 2023 17:25:36 +0000 Subject: [PATCH 62/72] Updated photolysis to use multiple model layers...if necessary. --- src/model/src/phot.F | 73 +++++++++++++++++++++++++------------------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index 99862a3..ed48c9c 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -308,7 +308,8 @@ SUBROUTINE PHOT ( MDATE, MTIME, JDATE, JTIME, DTSTEP, RJ ) REAL, ALLOCATABLE, SAVE :: RJ_CORRX ( : ) ! canopy height dependent photolysis attenuation factor REAL :: XCAN ( 2 ) ! canopy height interpolation bounds REAL :: YCAN ( 2 ) ! photolysisattenuation interpolation bounds - REAL ZFL, ZCAN, COUNTCAN, XCANOUT ! local canopyvariables + REAL ZFL, ZCAN, XCANOUT, BOTCAN ! local canopy variables + INTEGER :: COUNTCAN, KCAN INTEGER, PARAMETER :: MAXCAN = 1000 ! Declare local maximum canopy layers !...Variables for diagnostic outputs @@ -1016,23 +1017,31 @@ END SUBROUTINE O3TOTCOL !Makar, P., Staebler, R., Akingunola, A. et al. The effects of forest canopy shading and turbulence on boundary layer ozone. !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 - IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) -! WRITE(*,*) 'LAIE = ', Met_Data%LAIE( COL,ROW ) , -! & 'FCH = ', Met_Data%FCH( COL,ROW ), -! & 'FRT = ', Met_Data%FRT( COL,ROW), -! & 'POPU = ', Met_Data%POPU( COL,ROW), -! & 'CLU = ', Met_Data%CLU( COL,ROW) + IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) - !conditions for grid cells that do NOT have - !a continuous forest canopy + DO LEV = 1, NLAYS !loop through model layers + + IF (LEV .EQ. 1) THEN !first model layer + KCAN = 1 + ELSE !check subsequent model layers + IF ( Met_Data%FCH( COL,ROW ) .GT. Met_Data%ZF( COL,ROW,LEV-1 ) + & .AND. Met_Data%FCH( COL,ROW ) .LE. Met_Data%ZF( COL,ROW,LEV ) ) THEN + KCAN = 1 + ELSE + KCAN = 0 + END IF + END IF + + IF (KCAN .EQ. 1) THEN !canopy could be inside model layer + !check for otherconditions for grid cells that do NOT have + !a continuos forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 ) THEN -! & .OR. Met_Data%FCH( COL,ROW ) .LT. 10.0 -! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 -! & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 -! & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 -! & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN - RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, :) + & .OR. Met_Data%FCH( COL,ROW ) .LT. 1.0 + & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 + & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 + & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 + & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, :) ELSE ! There is a contiguous forest canopy,apply correctoin !RJ_CORR effectly represents the beam attenuation and reduces photolysis. !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. @@ -1050,12 +1059,18 @@ END SUBROUTINE O3TOTCOL RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) & *Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) -!Interpolate to get attenuation profile below canopy - ZFL = Met_Data%ZF( COL,ROW,1 ) - ZCAN = ZFL ! Initialize canopy top (m) = Bottom of First model layer above canopy -! ZCAN = Met_Data%FCH( COL,ROW ) ! Initialize canopy top (m) = Top of canopy +!Interpolate to get attenuation profile below canopy inside respective model layer + ZFL = Met_Data%ZF( COL,ROW,LEV ) + ZCAN = ZFL ! Initialize top (m) = Bottom of model layer COUNTCAN = 0 ! Initialize canopy layers - DO WHILE (ZCAN.GE.0.5) !canopy threshold >= 0.5 m + + IF (LEV .EQ. 1) THEN !Find bottom in each model layer + BOTCAN = 0.5 + ELSE + BOTCAN = Met_Data%ZF( COL,ROW,LEV-1 ) + END IF + + DO WHILE (ZCAN.GE.BOTCAN) IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN COUNTCAN = COUNTCAN + 1 ZCANX(COUNTCAN) = ZCAN @@ -1111,24 +1126,18 @@ END SUBROUTINE O3TOTCOL RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) END IF ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m -! WRITE(*,*) 'Met_Data%FCH = ', Met_Data%FCH( COL,ROW ), -! & 'ZCANX (COUNTCAN) = ', ZCANX (COUNTCAN), -! & 'RJ_CORRX (COUNTCAN) = ', RJ_CORRX (COUNTCAN) END DO !end loop on canopy layers !Integrate to get best attenuation value to use within canopy RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL -! WRITE(*,*) 'RJ_CORRX = ', RJ_CORRX(COUNTCAN:1:-1), -! & 'ZCANX = ', ZCANX(COUNTCAN:1:-1), -! & 'RJ_CORR (int) = ', RJ_CORR( COL,ROW ) !Apply attenuation factors above and below canopy - RJ( COL,ROW, 1, : ) = RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW ) + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values -! RJ( COL,ROW, 1, : ) = ( RJ( COL,ROW, 1, : ) -! & + (RJ( COL,ROW, 1, : )*RJ_CORR( COL,ROW )) )/2.0 - END IF !contigous canopy conditions - END IF !canopy shade + END IF !other contiguous canopy conditions + END IF !canopy height could be inside model layer + END DO !end loop on model layers + END IF !canopy shade IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients IF ( ANY( CLOUDS ) ) THEN From 5fd9e0bacebde2ef830ed9fc72d6c621c34dcb60 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Thu, 23 Mar 2023 17:30:34 +0000 Subject: [PATCH 63/72] Changed back to FCH > 0.5 m threshold for now... --- src/model/src/phot.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index ed48c9c..a48fd4f 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1036,7 +1036,7 @@ END SUBROUTINE O3TOTCOL !check for otherconditions for grid cells that do NOT have !a continuos forest canopy IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 1.0 + & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 From 7bdd55957dfc48db8397fbbaf7439d0ee440705f Mon Sep 17 00:00:00 2001 From: iri01 Date: Mon, 12 Feb 2024 21:42:41 +0000 Subject: [PATCH 64/72] Update to README add new canopy data --- README | 1 + 1 file changed, 1 insertion(+) diff --git a/README b/README index d1a50ac..11f793f 100644 --- a/README +++ b/README @@ -1 +1,2 @@ Modified branch to account for in-canopy effects on composition/weather +Adding New canopy data From dba670ea0fce90266404ab578f40ff5c28bd3fff Mon Sep 17 00:00:00 2001 From: iri01 Date: Wed, 14 Feb 2024 02:24:30 +0000 Subject: [PATCH 65/72] Export 3 photolysis diagnostics and 5 canopy fields from AQM to FV3. --- src/aqm_cap.F90 | 42 ++++---- src/aqm_comp_mod.F90 | 53 ++++++++++- src/shr/aqm_config_mod.F90 | 33 ++++++- src/shr/aqm_methods.F90 | 190 +++++++++++++++++++++++++++++++++++-- src/shr/aqm_state_mod.F90 | 18 +++- 5 files changed, 305 insertions(+), 31 deletions(-) diff --git a/src/aqm_cap.F90 b/src/aqm_cap.F90 index 94cc8a6..f5498fc 100644 --- a/src/aqm_cap.F90 +++ b/src/aqm_cap.F90 @@ -9,7 +9,7 @@ module AQM use aqm_comp_mod use aqm_const_mod, only: rad_to_deg - + implicit none ! -- import fields @@ -55,7 +55,7 @@ module AQM "temperature_of_soil_layer " & ! "forest_canopy_height ", & ! "forest_fraction ", & -! "clumping_index ", & +! "clumping_index ", & ! "population_density ", & ! "leaf_area_index_eccc ", & ! "cum_lai_frac1_eccc ", & @@ -64,28 +64,36 @@ module AQM ! "cum_lai_frac4_eccc ", & /) ! -- export fields - integer, parameter :: exportFieldCount = 2 + integer, parameter :: exportFieldCount = 2+3+5 !IVAI: add 3 photolysis inst_tracer_diag_* character(len=*), dimension(exportFieldCount), parameter :: & exportFieldNames = (/ & "inst_tracer_mass_frac ", & - "inst_tracer_diag_aod " & + "inst_tracer_diag_aod ", & + "inst_tracer_diag_claie ", & !IVAI: canopy via aqm_emis_read + "inst_tracer_diag_cfch ", & !IVAI: canopy via aqm_emis_read + "inst_tracer_diag_cfrt ", & !IVAI: canopy via aqm_emis_read + "inst_tracer_diag_cclu ", & !IVAI: canopy via aqm_emis_read + "inst_tracer_diag_cpopu ", & !IVAI: canopy via aqm_emis_read + "inst_tracer_diag_coszens ", & !IVAI: photdiag + "inst_tracer_diag_jo3o1d ", & !IVAI: photdiag + "inst_tracer_diag_jno2 " & !IVAI: photdiag /) private public SetServices - + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- - + subroutine SetServices(model, rc) type(ESMF_GridComp) :: model integer, intent(out) :: rc ! begin rc = ESMF_SUCCESS - + ! the NUOPC model component will register the generic methods call NUOPC_CompDerive(model, inheritModel, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -130,7 +138,7 @@ subroutine SetServices(model, rc) return ! bail out end subroutine - + !----------------------------------------------------------------------------- subroutine InitializeP0(model, importState, exportState, clock, rc) @@ -138,7 +146,7 @@ subroutine InitializeP0(model, importState, exportState, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - + ! local variables integer :: verbosity character(len=ESMF_MAXSTR) :: msgString, name, rcFile @@ -205,16 +213,16 @@ subroutine InitializeP0(model, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + end subroutine - + !----------------------------------------------------------------------------- subroutine InitializeP1(model, importState, exportState, clock, rc) type(ESMF_GridComp) :: model type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - + ! begin rc = ESMF_SUCCESS @@ -295,7 +303,7 @@ subroutine DataInitialize(model, rc) return ! bail out ! -- check if import fields are defined - if (importFieldCount < 1) then + if (importFieldCount < 1) then call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & msg="This component requires import fields to be defined.", & line=__LINE__, file=__FILE__, & @@ -304,7 +312,7 @@ subroutine DataInitialize(model, rc) end if ! -- check if export fields are defined - if (exportFieldCount < 1) then + if (exportFieldCount < 1) then call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & msg="This component requires export fields to be defined.", & line=__LINE__, file=__FILE__, & @@ -427,7 +435,7 @@ subroutine DataInitialize(model, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + do item = 1, 2 call ESMF_GridGetCoord(grid, coordDim=item, staggerloc=ESMF_STAGGERLOC_CENTER, & localDE=localDe, farrayPtr=coord, rc=rc) @@ -544,7 +552,7 @@ end subroutine DataInitialize subroutine ModelAdvance(model, rc) type(ESMF_GridComp) :: model integer, intent(out) :: rc - + ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState @@ -558,7 +566,7 @@ subroutine ModelAdvance(model, rc) ! begin rc = ESMF_SUCCESS - + ! get component's information call NUOPC_CompGet(model, name=name, diagnostic=diagnostic, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & diff --git a/src/aqm_comp_mod.F90 b/src/aqm_comp_mod.F90 index ecc81c5..157b032 100644 --- a/src/aqm_comp_mod.F90 +++ b/src/aqm_comp_mod.F90 @@ -325,6 +325,57 @@ subroutine aqm_comp_export(state, fieldNames, rc) line=__LINE__, & file=__FILE__)) & return ! bail +!IVAI: canopy fields read in via 'aqm_emiss_read' + case ("inst_tracer_diag_claie") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % claie, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_cfch") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfch, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_cfrt") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfrt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_cclu") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cclu, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_cpopu") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cpopu, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail +!IVAI: photdiag CTM_RJ_1 fields + case ("inst_tracer_diag_coszens") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % coszens, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_jo3o1d") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jo3o1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail + case ("inst_tracer_diag_jno2") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jno2, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail +!IVAI case default ! -- unused field end select @@ -605,7 +656,7 @@ subroutine aqm_comp_import(state, fieldNames, rc) line=__LINE__, & file=__FILE__)) & return ! bail -!canopy variables +!canopy variables ! case ("forest_canopy_height") ! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index 4147b7d..851dc9d 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -34,7 +34,7 @@ module aqm_config_mod logical :: biosw_yn = .false. logical :: ctm_aod = .false. logical :: ctm_depvfile = .false. - logical :: ctm_photodiag = .false. + logical :: ctm_photdiag = .true. !IVAI logical :: ctm_pmdiag = .false. logical :: ctm_wb_dust = .false. logical :: mie_optics = .false. @@ -183,6 +183,17 @@ subroutine aqm_config_read(model, config, rc) rcToReturn=rc)) & return ! bail out +!IVAI + ! -- read diagnostic settings + call ESMF_ConfigGetAttribute(cf, config % ctm_photdiag, & + label="ctm_photdiag:", default=.false., rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) & + return ! bail out +!IVAI + call ESMF_ConfigGetAttribute(cf, config % ctm_pmdiag, & label="ctm_pmdiag:", default=.false., rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & @@ -242,7 +253,6 @@ subroutine aqm_config_read(model, config, rc) ! -- set other default values config % ctm_depvfile = .false. - config % ctm_photodiag = .false. end subroutine aqm_config_read @@ -555,6 +565,25 @@ subroutine aqm_config_log(config, name, rc) rcToReturn=rc)) & return ! bail out end if +!IVAI + if (config % ctm_photdiag) then + call ESMF_LogWrite(trim(name) // ": config: read: ctm_photdiag: true", & + ESMF_LOGMSG_INFO, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) & + return ! bail out + else + call ESMF_LogWrite(trim(name) // ": config: read: ctm_photdiag: false", & + ESMF_LOGMSG_INFO, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc)) & + return ! bail out + end if +!IVAI if (config % ctm_wb_dust) then call ESMF_LogWrite(trim(name) // ": config: read: ctm_wb_dust: true", & ESMF_LOGMSG_INFO, rc=localrc) diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index a3c8787..0733d16 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -88,7 +88,7 @@ LOGICAL FUNCTION DESC3( FNAME ) CHARACTER(LEN=*), INTENT(IN) :: FNAME INCLUDE SUBST_FILES_ID - + integer :: localrc integer :: is, ie, js, je integer :: EMLAYS @@ -372,8 +372,8 @@ logical function envyn(name, description, defaultval, status) envyn = config % ctm_depvfile case ('CTM_PMDIAG') envyn = config % ctm_pmdiag - case ('CTM_PHOTODIAG') - envyn = config % ctm_photodiag + case ('CTM_PHOTDIAG') + envyn = config % ctm_photdiag case ('CTM_PT3DEMIS') envyn = aqm_emis_ispresent("gbbepx") .or. & aqm_emis_ispresent("point-source") @@ -551,7 +551,6 @@ INTEGER FUNCTION PROMPTFFILE( PROMPT, RDONLY, FMTTED, DEFAULT, CALLER ) END FUNCTION PROMPTFFILE - subroutine nameval(name, eqname) use aqm_emis_mod, only : aqm_internal_emis_type, aqm_emis_get @@ -600,7 +599,7 @@ subroutine nameval(name, eqname) case default ! -- nothing to do end select - + end subroutine nameval @@ -635,6 +634,7 @@ logical function interpx( fname, vname, pname, & real(AQM_KIND_R8), dimension(:,:,:), pointer :: p3d type(aqm_config_type), pointer :: config type(aqm_state_type), pointer :: stateIn + type(aqm_state_type), pointer :: stateOut !IVAI ! -- constants include SUBST_FILES_ID @@ -651,6 +651,7 @@ logical function interpx( fname, vname, pname, & nullify(p3d) nullify(config) nullify(stateIn) + nullify(stateOut) !IVAI set_non_neg = .false. if (trim(fname) == trim(GRID_CRO_2D)) then @@ -715,7 +716,7 @@ logical function interpx( fname, vname, pname, & call aqm_model_get(stateIn=stateIn, rc=localrc) if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return - + call aqm_model_get(config=config, stateIn=stateIn, rc=localrc) if (aqm_rc_check(localrc, msg="Failure to retrieve model input state", & file=__FILE__, line=__LINE__)) return @@ -835,6 +836,113 @@ logical function interpx( fname, vname, pname, & ! return end select +!IVAI + print*, 'AQM_METHODS: FNAME= ', FNAME, VNAME !IVAI : MET_CRO_2D + + IF ( TRIM( VNAME ) .EQ. TRIM('LAIE') ) THEN + + print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: LAIE +! print*, 'AQM_METHODS: LAIE = ', buffer(1:lbuf) + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + + stateOut % CLAIE (c,r) = buffer(k) + end do + end do + + + END IF + IF ( TRIM( VNAME ) .EQ. TRIM('FCH') ) THEN + + print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: FCH +! print*, 'AQM_METHODS: FCH = ', buffer(1:lbuf) + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + + stateOut % CFCH (c,r) = buffer(k) + end do + end do + + END IF + IF ( TRIM( VNAME ) .EQ. TRIM('FRT') ) THEN + + print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: FRT +! print*, 'AQM_METHODS: FRT = ', buffer(1:lbuf) + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + + stateOut % CFRT(c,r) = buffer(k) + end do + end do + + END IF + IF ( TRIM( VNAME ) .EQ. TRIM('CLU') ) THEN + + print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: CLU +! print*, 'AQM_METHODS: CLU = ', buffer(1:lbuf) + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + + stateOut % CCLU(c,r) = buffer(k) + end do + end do + + END IF + IF ( TRIM( VNAME ) .EQ. TRIM('POPU') ) THEN + + print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: POPU +! print*, 'AQM_METHODS: POPU= ', buffer(1:lbuf) + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + k = 0 + do r = row0, row1 + do c = col0, col1 + k = k + 1 + + stateOut % CPOPU(c,r) = buffer(k) + end do + end do + + END IF + +!IVAI + else if (trim(fname) == trim(OCEAN_1)) then select case (trim(vname)) @@ -1232,8 +1340,12 @@ LOGICAL FUNCTION WRITE3_REAL2D( FNAME, VNAME, JDATE, JTIME, BUFFER ) WRITE3_REAL2D = .FALSE. +! print*, 'AQM_METHODS: FNAME, VNAME= ', FNAME, VNAME !IVAI: CTM_AOD_1 ALL + IF ( TRIM( VNAME ) .EQ. TRIM( ALLVAR3 ) ) THEN +! print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: ADO + nullify(stateOut) call aqm_model_get(stateOut=stateOut, rc=localrc) if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & @@ -1241,12 +1353,78 @@ LOGICAL FUNCTION WRITE3_REAL2D( FNAME, VNAME, JDATE, JTIME, BUFFER ) stateOut % aod = BUFFER +! print*, 'AQM_METHODS: AOD pointer = ', aod !IVAI +! print*, 'AQM_METHODS: AOD = ', stateOut % aod !IVAI + END IF WRITE3_REAL2D = .TRUE. END IF +!IVAI + WRITE3_REAL2D = .TRUE. + + IF ( TRIM( FNAME ) .EQ. TRIM( CTM_RJ_1 ) ) THEN + + WRITE3_REAL2D = .FALSE. + + print*, 'AQM_METHODS: FNAME= ', FNAME, VNAME !IVAI: JO3O1D JNO2 ... (list of 15 vars) + + IF ( TRIM( VNAME ) .EQ. TRIM('COSZENS') ) THEN + +! print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: COSZENS + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + stateOut % coszens = BUFFER + +! print*, 'AQM_METHODS: COSZENS pointer = ', coszens +! print*, 'AQM_METHODS: COSZENS = ', BUFFER + + END IF + + IF ( TRIM( VNAME ) .EQ. TRIM('JO3O1D') ) THEN + +! print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: JO3O1D + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + stateOut % JO3O1D = BUFFER + +! print*, 'AQM_METHODS: JO3O1D pointer = ', JO3O1D +! print*, 'AQM_METHODS: JO3O1D = ', BUFFER + + END IF + + IF ( TRIM( VNAME ) .EQ. TRIM('JNO2') ) THEN + +! print*, 'AQM_METHODS: VNAME= ', VNAME !IVAI: JNO2 + + nullify(stateOut) + call aqm_model_get(stateOut=stateOut, rc=localrc) + if (aqm_rc_check(localrc, msg="Failure to retrieve model output state", & + file=__FILE__, line=__LINE__)) return + + stateOut % JNO2 = BUFFER + +! print*, 'AQM_METHODS: JNO2 pointer = ', JNO2 +! print*, 'AQM_METHODS: JNO2 = ', BUFFER + + END IF + + WRITE3_REAL2D = .TRUE. + + END IF ! CTM_RJ_1 + +!IVAI + END FUNCTION WRITE3_REAL2D LOGICAL FUNCTION WRITE3_REAL4D( FNAME, VNAME, JDATE, JTIME, BUFFER ) diff --git a/src/shr/aqm_state_mod.F90 b/src/shr/aqm_state_mod.F90 index 0dff89d..b03d60f 100644 --- a/src/shr/aqm_state_mod.F90 +++ b/src/shr/aqm_state_mod.F90 @@ -46,12 +46,14 @@ module aqm_state_mod real(AQM_KIND_R8), dimension(:,:,:,:), pointer :: tr => null() +!IVAI ! -- canopy variables -! real(AQM_KIND_R8), dimension(:,:), pointer :: cfch => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cfrt => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cclu => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cpopu => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: claie => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: cfch => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: cfrt => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: cclu => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: cpopu => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: claie => null() +!IVAI ! real(AQM_KIND_R8), dimension(:,:), pointer :: cc1r => null() ! real(AQM_KIND_R8), dimension(:,:), pointer :: cc2r => null() ! real(AQM_KIND_R8), dimension(:,:), pointer :: cc3r => null() @@ -59,6 +61,12 @@ module aqm_state_mod ! -- diagnostics real(AQM_KIND_R8), dimension(:,:), pointer :: aod => null() +!IVAI: photolysis + real(AQM_KIND_R8), dimension(:,:), pointer :: coszens => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: jo3o1d => null() + real(AQM_KIND_R8), dimension(:,:), pointer :: jno2 => null() +! +!IVAI end type aqm_state_type From 9b3c969ecd45fcaf817711bd78f0db9c242050a5 Mon Sep 17 00:00:00 2001 From: iri01 <129897017+iri01@users.noreply.github.com> Date: Wed, 14 Feb 2024 16:59:24 -0500 Subject: [PATCH 66/72] Update README Co-authored-by: Patrick Campbell --- README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README b/README index 11f793f..d65db6d 100644 --- a/README +++ b/README @@ -1,2 +1,2 @@ Modified branch to account for in-canopy effects on composition/weather -Adding New canopy data +Export 5 2D canopy data fields and 3 2D photolysis diagnostics (I. Ivanova, 02/14/2024) From 824ea89056523d8ed5ac4787f82d5d666ce336d9 Mon Sep 17 00:00:00 2001 From: iri01 <129897017+iri01@users.noreply.github.com> Date: Wed, 14 Feb 2024 17:00:03 -0500 Subject: [PATCH 67/72] Update src/aqm_cap.F90 Co-authored-by: Patrick Campbell --- src/aqm_cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aqm_cap.F90 b/src/aqm_cap.F90 index f5498fc..38d263c 100644 --- a/src/aqm_cap.F90 +++ b/src/aqm_cap.F90 @@ -64,7 +64,7 @@ module AQM ! "cum_lai_frac4_eccc ", & /) ! -- export fields - integer, parameter :: exportFieldCount = 2+3+5 !IVAI: add 3 photolysis inst_tracer_diag_* + integer, parameter :: exportFieldCount = 2+3+5 !IVAI: add 3 photolysis inst_tracer_diag_* and five canopy variables character(len=*), dimension(exportFieldCount), parameter :: & exportFieldNames = (/ & "inst_tracer_mass_frac ", & From 344d3db40d89c9af091481983a779d0b819b6c61 Mon Sep 17 00:00:00 2001 From: iri01 <129897017+iri01@users.noreply.github.com> Date: Thu, 15 Feb 2024 12:31:37 -0500 Subject: [PATCH 68/72] Update src/shr/aqm_config_mod.F90 Co-authored-by: Patrick Campbell --- src/shr/aqm_config_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index 851dc9d..b5c9d96 100644 --- a/src/shr/aqm_config_mod.F90 +++ b/src/shr/aqm_config_mod.F90 @@ -34,7 +34,7 @@ module aqm_config_mod logical :: biosw_yn = .false. logical :: ctm_aod = .false. logical :: ctm_depvfile = .false. - logical :: ctm_photdiag = .true. !IVAI + logical :: ctm_photdiag = .false. !IVAI logical :: ctm_pmdiag = .false. logical :: ctm_wb_dust = .false. logical :: mie_optics = .false. From faa2403c0986a4fe83104d76417c3c99878053ea Mon Sep 17 00:00:00 2001 From: iri01 Date: Wed, 6 Mar 2024 03:35:12 +0000 Subject: [PATCH 69/72] Modified contiguous canopy condition for FRT with the new canopy data. --- src/model/src/phot.F | 224 ++++++++++++++++++++++--------------------- 1 file changed, 117 insertions(+), 107 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index a48fd4f..eea4183 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1017,127 +1017,137 @@ END SUBROUTINE O3TOTCOL !Makar, P., Staebler, R., Akingunola, A. et al. The effects of forest canopy shading and turbulence on boundary layer ozone. !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 - IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) - - DO LEV = 1, NLAYS !loop through model layers - - IF (LEV .EQ. 1) THEN !first model layer - KCAN = 1 - ELSE !check subsequent model layers - IF ( Met_Data%FCH( COL,ROW ) .GT. Met_Data%ZF( COL,ROW,LEV-1 ) - & .AND. Met_Data%FCH( COL,ROW ) .LE. Met_Data%ZF( COL,ROW,LEV ) ) THEN - KCAN = 1 - ELSE - KCAN = 0 - END IF - END IF - - IF (KCAN .EQ. 1) THEN !canopy could be inside model layer - !check for otherconditions for grid cells that do NOT have - !a continuos forest canopy - IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 - & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 - & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 - & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 - & .OR. EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 - & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 ) THEN - RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, :) - ELSE ! There is a contiguous forest canopy,apply correctoin - !RJ_CORR effectly represents the beam attenuation and reduces photolysis. - !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. - !Meterol. 8, 25⚌~Z~L~@~S38 (1971). + IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) + + DO LEV = 1, NLAYS !loop through model layers + + IF (LEV .EQ. 1) THEN !first model layer + KCAN = 1 + ELSE !check subsequent model layers + IF ( Met_Data%FCH( COL,ROW ) .GT. Met_Data%ZF( COL,ROW,LEV-1 ) + & .AND. Met_Data%FCH( COL,ROW ) .LE. Met_Data%ZF( COL,ROW,LEV ) ) THEN + KCAN = 1 + ELSE + KCAN = 0 + END IF + END IF + + IF (KCAN .EQ. 1) THEN !canopy could be inside model layer + + !check for other conditions for grid cells that do NOT have a continuos forest canopy + IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 + & .OR. Met_Data%FCH ( COL,ROW ) .LT. 0.5 +!IVAI: Modified condition with the new canopy data +! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 + & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.75 +!IVAI + & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 + & .OR. (EXP(-0.5*Met_Data%LAIE( COL,ROW )* + & Met_Data%CLU ( COL,ROW )).GT. 0.45 + & .AND. Met_Data%FCH ( COL,ROW ) .LT. 18.0) ) THEN + + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, :) + + ELSE ! There is a contiguous forest canopy,apply correctoin + !RJ_CORR effectly represents the beam attenuation and reduces photolysis. + !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. + !Meterol. 8, 25⚌~Z~L~@~S38 (1971). !Calculate attenuation at different set cumulative LAI fractions downward through canopy (C1R, C2R, C3R, C4R data from ECCC) - RJ_CORR_C1R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C1R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C1R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C2R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C2R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C2R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C3R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C3R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C3R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C4R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C4R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C4R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) + RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) & *Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) !Interpolate to get attenuation profile below canopy inside respective model layer - ZFL = Met_Data%ZF( COL,ROW,LEV ) - ZCAN = ZFL ! Initialize top (m) = Bottom of model layer - COUNTCAN = 0 ! Initialize canopy layers - - IF (LEV .EQ. 1) THEN !Find bottom in each model layer - BOTCAN = 0.5 - ELSE - BOTCAN = Met_Data%ZF( COL,ROW,LEV-1 ) - END IF - - DO WHILE (ZCAN.GE.BOTCAN) - IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN - COUNTCAN = COUNTCAN + 1 - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = 1.0 - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW ) .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.75 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW ) - YCAN(2) = 1.0 - XCAN(1) = Met_Data%FCH( COL,ROW )*0.75 - YCAN(1) = RJ_CORR_C1R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.75 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.50 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.75 - YCAN(2) = RJ_CORR_C1R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.50 - YCAN(1) = RJ_CORR_C2R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.50 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.35 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.50 - YCAN(2) = RJ_CORR_C2R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.35 - YCAN(1) = RJ_CORR_C3R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.35 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.20 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.35 - YCAN(2) = RJ_CORR_C3R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.20 - YCAN(1) = RJ_CORR_C4R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.20 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.20 - YCAN(2) = RJ_CORR_C4R( COL,ROW ) - XCAN(1) = 0.5 - YCAN(1) = RJ_CORR_BOT( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - END IF - ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m - END DO !end loop on canopy layers + ZFL = Met_Data%ZF( COL,ROW,LEV ) + ZCAN = ZFL ! Initialize top (m) = Bottom of model layer + COUNTCAN = 0 ! Initialize canopy layers + + IF (LEV .EQ. 1) THEN !Find bottom in each model layer + BOTCAN = 0.5 + ELSE + BOTCAN = Met_Data%ZF( COL,ROW,LEV-1 ) + END IF + + DO WHILE (ZCAN.GE.BOTCAN) + IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN + COUNTCAN = COUNTCAN + 1 + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = 1.0 + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW ) .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.75 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW ) + YCAN(2) = 1.0 + XCAN(1) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(1) = RJ_CORR_C1R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.75 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.50 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(2) = RJ_CORR_C1R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(1) = RJ_CORR_C2R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.50 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.35 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(2) = RJ_CORR_C2R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(1) = RJ_CORR_C3R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.35 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(2) = RJ_CORR_C3R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(1) = RJ_CORR_C4R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(2) = RJ_CORR_C4R( COL,ROW ) + XCAN(1) = 0.5 + YCAN(1) = RJ_CORR_BOT( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + END IF + ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m + END DO !end loop on canopy layers !Integrate to get best attenuation value to use within canopy - RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / + RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL !Apply attenuation factors above and below canopy - RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, : )*RJ_CORR( COL,ROW ) + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values - END IF !other contiguous canopy conditions - END IF !canopy height could be inside model layer - END DO !end loop on model layers - END IF !canopy shade + + END IF !other contiguous canopy conditions + + END IF !canopy height could be inside model layer + + END DO !end loop on model layers + + END IF !canopy shade IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients IF ( ANY( CLOUDS ) ) THEN From a002d5b05d3d1e3790e6147af99c6afd88cb48b7 Mon Sep 17 00:00:00 2001 From: iri01 Date: Wed, 6 Mar 2024 16:05:02 +0000 Subject: [PATCH 70/72] Modified FRT condition for new canopy data. --- src/model/src/phot.F | 225 +++++++++++++++++++++---------------------- 1 file changed, 108 insertions(+), 117 deletions(-) diff --git a/src/model/src/phot.F b/src/model/src/phot.F index eea4183..1b8fd87 100644 --- a/src/model/src/phot.F +++ b/src/model/src/phot.F @@ -1017,137 +1017,128 @@ END SUBROUTINE O3TOTCOL !Makar, P., Staebler, R., Akingunola, A. et al. The effects of forest canopy shading and turbulence on boundary layer ozone. !Nat Commun 8, 15243 (2017). https://doi.org/10.1038/ncomms15243 - IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) - - DO LEV = 1, NLAYS !loop through model layers - - IF (LEV .EQ. 1) THEN !first model layer - KCAN = 1 - ELSE !check subsequent model layers - IF ( Met_Data%FCH( COL,ROW ) .GT. Met_Data%ZF( COL,ROW,LEV-1 ) - & .AND. Met_Data%FCH( COL,ROW ) .LE. Met_Data%ZF( COL,ROW,LEV ) ) THEN - KCAN = 1 - ELSE - KCAN = 0 - END IF - END IF - - IF (KCAN .EQ. 1) THEN !canopy could be inside model layer - - !check for other conditions for grid cells that do NOT have a continuos forest canopy - IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 - & .OR. Met_Data%FCH ( COL,ROW ) .LT. 0.5 -!IVAI: Modified condition with the new canopy data -! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 - & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.75 -!IVAI - & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 - & .OR. (EXP(-0.5*Met_Data%LAIE( COL,ROW )* - & Met_Data%CLU ( COL,ROW )).GT. 0.45 - & .AND. Met_Data%FCH ( COL,ROW ) .LT. 18.0) ) THEN - - RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, :) - - ELSE ! There is a contiguous forest canopy,apply correctoin - !RJ_CORR effectly represents the beam attenuation and reduces photolysis. - !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. - !Meterol. 8, 25⚌~Z~L~@~S38 (1971). + IF ( CANOPY_SHADE ) THEN ! compute canopy shade reduction factor (RJ_CORR) + + DO LEV = 1, NLAYS !loop through model layers + + IF (LEV .EQ. 1) THEN !first model layer + KCAN = 1 + ELSE !check subsequent model layers + IF ( Met_Data%FCH( COL,ROW ) .GT. Met_Data%ZF( COL,ROW,LEV-1 ) + & .AND. Met_Data%FCH( COL,ROW ) .LE. Met_Data%ZF( COL,ROW,LEV ) ) THEN + KCAN = 1 + ELSE + KCAN = 0 + END IF + END IF + + IF (KCAN .EQ. 1) THEN !canopy could be inside model layer + !check for otherconditions for grid cells that do NOT have + !a continuos forest canopy + IF ( Met_Data%LAIE( COL,ROW ) .LT. 0.1 + & .OR. Met_Data%FCH( COL,ROW ) .LT. 0.5 +! & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.5 !IVAI: old canopy data + & .OR. MAX(0.0, 1.0 - Met_Data%FRT( COL,ROW)) .GT. 0.75 !IVAI: new canopy data + & .OR. Met_Data%POPU( COL,ROW ) .GT.10000.0 + & .OR. (EXP(-0.5*Met_Data%LAIE( COL,ROW)*Met_Data%CLU( COL,ROW )) .GT. 0.45 + & .AND. Met_Data%FCH(COL,ROW ) .LT. 18.0 )) THEN + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, :) + ELSE ! There is a contiguous forest canopy,apply correctoin + !RJ_CORR effectly represents the beam attenuation and reduces photolysis. + !Nilson, T. A theoretical analysis of the frequency of gaps in plant stands. Agric. + !Meterol. 8, 25⚌~Z~L~@~S38 (1971). !Calculate attenuation at different set cumulative LAI fractions downward through canopy (C1R, C2R, C3R, C4R data from ECCC) - RJ_CORR_C1R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C1R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C1R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C2R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C2R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C2R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C3R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C3R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C3R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_C4R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) + RJ_CORR_C4R( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*(Met_Data%LAIE( COL,ROW ) & *Met_Data%C4R( COL,ROW ))*Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) - RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) + RJ_CORR_BOT( COL,ROW ) = MAX(1.0E-10, EXP(-1.0*(0.5*Met_Data%LAIE( COL,ROW ) & *Met_Data%CLU( COL,ROW ))/MAX(0.05, COSZEN))) !Interpolate to get attenuation profile below canopy inside respective model layer - ZFL = Met_Data%ZF( COL,ROW,LEV ) - ZCAN = ZFL ! Initialize top (m) = Bottom of model layer - COUNTCAN = 0 ! Initialize canopy layers - - IF (LEV .EQ. 1) THEN !Find bottom in each model layer - BOTCAN = 0.5 - ELSE - BOTCAN = Met_Data%ZF( COL,ROW,LEV-1 ) - END IF - - DO WHILE (ZCAN.GE.BOTCAN) - IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN - COUNTCAN = COUNTCAN + 1 - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = 1.0 - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW ) .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.75 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW ) - YCAN(2) = 1.0 - XCAN(1) = Met_Data%FCH( COL,ROW )*0.75 - YCAN(1) = RJ_CORR_C1R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.75 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.50 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.75 - YCAN(2) = RJ_CORR_C1R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.50 - YCAN(1) = RJ_CORR_C2R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.50 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.35 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.50 - YCAN(2) = RJ_CORR_C2R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.35 - YCAN(1) = RJ_CORR_C3R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.35 .AND. - & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.20 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.35 - YCAN(2) = RJ_CORR_C3R( COL,ROW ) - XCAN(1) = Met_Data%FCH( COL,ROW )*0.20 - YCAN(1) = RJ_CORR_C4R( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.20 ) THEN - COUNTCAN = COUNTCAN + 1 - XCAN(2) = Met_Data%FCH( COL,ROW )*0.20 - YCAN(2) = RJ_CORR_C4R( COL,ROW ) - XCAN(1) = 0.5 - YCAN(1) = RJ_CORR_BOT( COL,ROW ) - XCANOUT = ZCAN - ZCANX(COUNTCAN) = ZCAN - RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) - END IF - ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m - END DO !end loop on canopy layers + ZFL = Met_Data%ZF( COL,ROW,LEV ) + ZCAN = ZFL ! Initialize top (m) = Bottom of model layer + COUNTCAN = 0 ! Initialize canopy layers + + IF (LEV .EQ. 1) THEN !Find bottom in each model layer + BOTCAN = 0.5 + ELSE + BOTCAN = Met_Data%ZF( COL,ROW,LEV-1 ) + END IF + + DO WHILE (ZCAN.GE.BOTCAN) + IF ( ZCAN .GT. Met_Data%FCH( COL,ROW ) ) THEN + COUNTCAN = COUNTCAN + 1 + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = 1.0 + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW ) .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.75 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW ) + YCAN(2) = 1.0 + XCAN(1) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(1) = RJ_CORR_C1R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.75 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.50 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.75 + YCAN(2) = RJ_CORR_C1R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(1) = RJ_CORR_C2R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.50 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.35 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.50 + YCAN(2) = RJ_CORR_C2R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(1) = RJ_CORR_C3R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.35 .AND. + & ZCAN .GT. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.35 + YCAN(2) = RJ_CORR_C3R( COL,ROW ) + XCAN(1) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(1) = RJ_CORR_C4R( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + ELSE IF ( ZCAN .LE. Met_Data%FCH( COL,ROW )*0.20 ) THEN + COUNTCAN = COUNTCAN + 1 + XCAN(2) = Met_Data%FCH( COL,ROW )*0.20 + YCAN(2) = RJ_CORR_C4R( COL,ROW ) + XCAN(1) = 0.5 + YCAN(1) = RJ_CORR_BOT( COL,ROW ) + XCANOUT = ZCAN + ZCANX(COUNTCAN) = ZCAN + RJ_CORRX (COUNTCAN) = interp_linear1_internal(XCAN,YCAN,XCANOUT) + END IF + ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5 m + END DO !end loop on canopy layers !Integrate to get best attenuation value to use within canopy - RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / + RJ_CORR( COL,ROW ) = IntegrateTrapezoid(ZCANX(COUNTCAN:1:-1),RJ_CORRX(COUNTCAN:1:-1)) / & ZFL !Apply attenuation factors above and below canopy - RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, : )*RJ_CORR( COL,ROW ) + RJ( COL,ROW, LEV, : ) = RJ( COL,ROW, LEV, : )*RJ_CORR( COL,ROW ) !Apply attenuation value within canopy and take average above and within canopy values - - END IF !other contiguous canopy conditions - - END IF !canopy height could be inside model layer - - END DO !end loop on model layers - - END IF !canopy shade + END IF !other contiguous canopy conditions + END IF !canopy height could be inside model layer + END DO !end loop on model layers + END IF !canopy shade IF ( JTIME_CHK ) THEN ! compute clear sky reflection and transmission coefficients IF ( ANY( CLOUDS ) ) THEN From 00d861e5e5b90e043b38c6bdf6e9be01bb10cffd Mon Sep 17 00:00:00 2001 From: iri01 Date: Sun, 2 Mar 2025 01:05:25 +0000 Subject: [PATCH 71/72] Clean up unused canopy arrays --- src/aqm_cap.F90 | 20 +++------- src/aqm_comp_mod.F90 | 91 +++++++++----------------------------------- 2 files changed, 23 insertions(+), 88 deletions(-) diff --git a/src/aqm_cap.F90 b/src/aqm_cap.F90 index 38d263c..98c30a0 100644 --- a/src/aqm_cap.F90 +++ b/src/aqm_cap.F90 @@ -14,7 +14,6 @@ module AQM ! -- import fields integer, parameter :: importFieldCount = 36 -! integer, parameter :: importFieldCount = 45 !with canopy character(len=*), dimension(importFieldCount), parameter :: & importFieldNames = (/ & "canopy_moisture_storage ", & @@ -53,30 +52,21 @@ module AQM "surface_cell_area ", & "surface_snow_area_fraction ", & "temperature_of_soil_layer " & -! "forest_canopy_height ", & -! "forest_fraction ", & -! "clumping_index ", & -! "population_density ", & -! "leaf_area_index_eccc ", & -! "cum_lai_frac1_eccc ", & -! "cum_lai_frac2_eccc ", & -! "cum_lai_frac3_eccc ", & -! "cum_lai_frac4_eccc ", & /) ! -- export fields - integer, parameter :: exportFieldCount = 2+3+5 !IVAI: add 3 photolysis inst_tracer_diag_* and five canopy variables + integer, parameter :: exportFieldCount = 2 + 5 + 3 !IVAI: add 5 canopy data fields add 3 photdiag arrays character(len=*), dimension(exportFieldCount), parameter :: & exportFieldNames = (/ & "inst_tracer_mass_frac ", & "inst_tracer_diag_aod ", & + "inst_tracer_diag_coszens ", & !IVAI: photdiag + "inst_tracer_diag_jo3o1d ", & !IVAI: photdiag + "inst_tracer_diag_jno2 ", & !IVAI: photdiag "inst_tracer_diag_claie ", & !IVAI: canopy via aqm_emis_read "inst_tracer_diag_cfch ", & !IVAI: canopy via aqm_emis_read "inst_tracer_diag_cfrt ", & !IVAI: canopy via aqm_emis_read "inst_tracer_diag_cclu ", & !IVAI: canopy via aqm_emis_read - "inst_tracer_diag_cpopu ", & !IVAI: canopy via aqm_emis_read - "inst_tracer_diag_coszens ", & !IVAI: photdiag - "inst_tracer_diag_jo3o1d ", & !IVAI: photdiag - "inst_tracer_diag_jno2 " & !IVAI: photdiag + "inst_tracer_diag_cpopu " & !IVAI: canopy via aqm_emis_read /) private diff --git a/src/aqm_comp_mod.F90 b/src/aqm_comp_mod.F90 index 157b032..7433755 100644 --- a/src/aqm_comp_mod.F90 +++ b/src/aqm_comp_mod.F90 @@ -325,52 +325,52 @@ subroutine aqm_comp_export(state, fieldNames, rc) line=__LINE__, & file=__FILE__)) & return ! bail -!IVAI: canopy fields read in via 'aqm_emiss_read' - case ("inst_tracer_diag_claie") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % claie, rc=rc) +!IVAI: photdiag CTM_RJ_1 fields + case ("inst_tracer_diag_coszens") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % coszens, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_cfch") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfch, rc=rc) + case ("inst_tracer_diag_jo3o1d") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jo3o1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_cfrt") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfrt, rc=rc) + case ("inst_tracer_diag_jno2") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jno2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_cclu") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cclu, rc=rc) +!IVAI: canopy fields read in via 'aqm_emiss_read' + case ("inst_tracer_diag_claie") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % claie, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_cpopu") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cpopu, rc=rc) + case ("inst_tracer_diag_cfch") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfch, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail -!IVAI: photdiag CTM_RJ_1 fields - case ("inst_tracer_diag_coszens") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % coszens, rc=rc) + case ("inst_tracer_diag_cfrt") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cfrt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_jo3o1d") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jo3o1d, rc=rc) + case ("inst_tracer_diag_cclu") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cclu, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail - case ("inst_tracer_diag_jno2") - call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % jno2, rc=rc) + case ("inst_tracer_diag_cpopu") + call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateOut % cpopu, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -656,61 +656,6 @@ subroutine aqm_comp_import(state, fieldNames, rc) line=__LINE__, & file=__FILE__)) & return ! bail -!canopy variables -! case ("forest_canopy_height") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("forest_fraction") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("clumping_index") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("population_density") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("leaf_area_index_eccc") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("cum_lai_frac1_eccc") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("cum_lai_frac2_eccc") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("cum_lai_frac3_eccc") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail -! case ("cum_lai_frac4_eccc") -! call ESMF_FieldGet(field, localDe=localDe, farrayPtr=stateIn % stemp, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail case default ! -- unused field end select From 07c587f869be0a72675593bb8bed645396082559 Mon Sep 17 00:00:00 2001 From: iri01 Date: Sun, 2 Mar 2025 01:18:46 +0000 Subject: [PATCH 72/72] Clean up unused canopy variables --- src/shr/aqm_state_mod.F90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/shr/aqm_state_mod.F90 b/src/shr/aqm_state_mod.F90 index b03d60f..fe243f8 100644 --- a/src/shr/aqm_state_mod.F90 +++ b/src/shr/aqm_state_mod.F90 @@ -54,22 +54,17 @@ module aqm_state_mod real(AQM_KIND_R8), dimension(:,:), pointer :: cpopu => null() real(AQM_KIND_R8), dimension(:,:), pointer :: claie => null() !IVAI -! real(AQM_KIND_R8), dimension(:,:), pointer :: cc1r => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cc2r => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cc3r => null() -! real(AQM_KIND_R8), dimension(:,:), pointer :: cc4r => null() ! -- diagnostics real(AQM_KIND_R8), dimension(:,:), pointer :: aod => null() -!IVAI: photolysis +!IVAI: + ! -- photolysis diagnostics real(AQM_KIND_R8), dimension(:,:), pointer :: coszens => null() real(AQM_KIND_R8), dimension(:,:), pointer :: jo3o1d => null() real(AQM_KIND_R8), dimension(:,:), pointer :: jno2 => null() -! !IVAI end type aqm_state_type public - end module aqm_state_mod