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/37] Initial commit of rrfs_cmaq_canopy branch. --- README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README b/README index 8b137891..d1a50ac7 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/37] 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 00000000..8cad21f2 --- /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 00000000..7d93deca --- /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 00000000..66c9531c --- /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/37] 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 8cad21f2..197be5f0 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 7d93deca..00000000 --- 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/37] 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 61c4887b..e27058a3 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 0c12a885..d5864b40 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/37] 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 656ce860..c8624b0c 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 fc2c194f..958d6011 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/37] 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 bfbee4a3..d1464650 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 788fac9b..75b182c6 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/37] 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 197be5f0..251cecaa 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 f6722cc8..5a2c80b4 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 84fc163c..5eb35e80 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 c8624b0c..11152406 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/37] 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 e7e018c7..0a3af4a6 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 5eb35e80..27a01fd0 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 11152406..72733cd0 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/37] 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 d5864b40..5ae221b9 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 251cecaa..47e69047 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 5a2c80b4..122ea481 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 72733cd0..c23ee5b2 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/37] 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 47e69047..f2f87697 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 122ea481..75147340 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/37] 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 f2f87697..31ec03e6 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 75147340..d31a8932 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/37] 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 31ec03e6..df720978 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 d31a8932..af05bc37 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/37] 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 c23ee5b2..ac632885 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/37] 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 ac632885..9621b3bc 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/37] 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 df720978..26b1189a 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 9621b3bc..00401254 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/37] 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 26b1189a..7970b836 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 af05bc37..b3be964e 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 00401254..6c44dd5c 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/37] 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 b3be964e..8bf6e526 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/37] 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 7970b836..ac390663 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 8bf6e526..198f5c72 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 6c44dd5c..00401254 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/37] 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 ac390663..0fcdd2c1 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 00401254..551851b4 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/37] 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 0fcdd2c1..52acaf3f 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 551851b4..4561829e 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/37] 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 52acaf3f..49f851d8 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 198f5c72..9f0c077a 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/37] 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 9f0c077a..fe83f6d4 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/37] 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 fe83f6d4..86ad888f 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/37] 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 5ae221b9..4d3ea17e 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/37] 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 4d3ea17e..09eebf25 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/37] 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 0a3af4a6..6cea1b38 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/37] 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 6cea1b38..b7ec0f21 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/37] 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 b7ec0f21..6d805d68 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/37] 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 a579595d..7aa77870 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/37] 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 6d805d68..50665182 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 5590ef1d..0e362160 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/37] 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 7aa77870..696d74a8 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/37] 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 c3f7420c..b6c0d24a 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/37] 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 b6c0d24a..8493a22d 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/37] 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 8493a22d..5798ed0a 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 203035553bff8fb84fca1966168134b951093b68 Mon Sep 17 00:00:00 2001 From: drnimbusrain Date: Thu, 25 Aug 2022 21:01:06 +0000 Subject: [PATCH 35/37] 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 86ad888f..655f9659 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 0eca9b525487b5363df155e5a326de826d6e4274 Mon Sep 17 00:00:00 2001 From: Raffaele Montuoro Date: Fri, 9 Sep 2022 11:25:50 -0400 Subject: [PATCH 36/37] Restore link to CMAQ authoritative repository (#8) * Handle conflict with FMS mosaic_mod module. * Remove unnecessary ESMF linking dependencies. --- .gitmodules | 4 ++-- CMakeLists.txt | 12 ++++++++++-- src/model/CMAQ | 2 +- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 44875080..b13c4868 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "src/model/CMAQ"] path = src/model/CMAQ - url = https://github.com/NOAA-EMC/CMAQ - branch = dev/emc + url = https://github.com/USEPA/CMAQ + branch = 5.2.1 diff --git a/CMakeLists.txt b/CMakeLists.txt index 35b9e6f7..5fe78d86 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -50,7 +50,8 @@ target_include_directories(drv PRIVATE $ $) target_compile_definitions(drv PUBLIC verbose_driver) -target_link_libraries(drv PRIVATE shr CCTM esmf) +#target_link_libraries(drv PRIVATE shr CCTM esmf) +target_link_libraries(drv PRIVATE shr CCTM) # src/io/aqmio add_library(aqmio OBJECT ${aqm_aqmio_files}) @@ -86,6 +87,8 @@ target_compile_definitions(CCTM PUBLIC SUBST_FILES_ID="FILES_CTM.EXT" SUBST_BARRIER=NOOP_BARRIER SUBST_SUBGRID_INDEX=NOOP_SUBGRID_INDEX EDDYX=DUMMY_EDDYX + MOSAIC_MOD=MOSAIC_MODULE + Mosaic_Mod=Mosaic_Module OPCONC=DUMMY_OPCONC OPACONC=DUMMY_OPACONC OPWDEP=DUMMY_OPWDEP @@ -94,7 +97,6 @@ target_compile_definitions(CCTM PUBLIC SUBST_FILES_ID="FILES_CTM.EXT" verbose_gas mpas _AQM_) -target_link_libraries(CCTM PRIVATE esmf) # AQM add_library(aqm STATIC ${aqm_files} $ @@ -103,6 +105,12 @@ add_library(aqm STATIC ${aqm_files} $ $ $) set_target_properties(aqm PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/mod) +add_custom_target(aqm_mosaic + COMMAND ${CMAKE_COMMAND} -E create_symlink + ${CMAKE_CURRENT_BINARY_DIR}/mod/mosaic_module.mod + ${CMAKE_CURRENT_BINARY_DIR}/mod/mosaic_mod.mod + ) +add_dependencies(aqm aqm_mosaic) add_library(aqm::aqm ALIAS aqm) target_include_directories(aqm PUBLIC $ $) diff --git a/src/model/CMAQ b/src/model/CMAQ index b82dc06e..be5d28fd 160000 --- a/src/model/CMAQ +++ b/src/model/CMAQ @@ -1 +1 @@ -Subproject commit b82dc06e573efabb67f6d7938c20adfb9b45d3d2 +Subproject commit be5d28fd1b60522e6fc98aefeead20e6aac3530b From d7916abff01fe44859c6ec307bafb2426ca3f632 Mon Sep 17 00:00:00 2001 From: Barry Baker Date: Thu, 15 Sep 2022 21:44:20 -0400 Subject: [PATCH 37/37] Adding Fengsha dust emission scheme (#6) * adding ASX data module --- aqm_files.cmake | 4 +- examples/aqm.rc | 16 + src/model/Makefile.am | 63 +- src/model/Makefile.in | 96 +-- src/model/src/ASX_DATA_MOD.F | 1464 ++++++++++++++++++++++++++++++++ src/model/src/DUST_EMIS.F | 1527 ++++++++++++++++++++++++++++++++++ src/shr/aqm_config_mod.F90 | 19 +- src/shr/aqm_emis_mod.F90 | 7 + src/shr/aqm_methods.F90 | 62 +- 9 files changed, 3172 insertions(+), 86 deletions(-) create mode 100755 src/model/src/ASX_DATA_MOD.F create mode 100644 src/model/src/DUST_EMIS.F diff --git a/aqm_files.cmake b/aqm_files.cmake index c3f7420c..bba274bc 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,6 @@ list(APPEND aqm_CCTM_files ${localCCTM}/vdiffacmx.F ${localCCTM}/PTMAP.F ${localCCTM}/PT3D_DEFN.F + ${localCCTM}/ASX_DATA_MOD.F + ${localCCTM}/DUST_EMIS.F ) diff --git a/examples/aqm.rc b/examples/aqm.rc index e7e018c7..b09c9e5f 100644 --- a/examples/aqm.rc +++ b/examples/aqm.rc @@ -55,6 +55,20 @@ ctm_aod: true # Compute and export PM2.5 mode fractions as diagnostic tracers ctm_pmdiag: true +# +# Fengsha Dust Emission Option +# +fengsha_yn: true + +fengsha_format: netcdf + +fengsha_file: /scratch1/RDARCH/rda-arl-gpu/Barry.Baker/emissions/nexus/FENGSHA/FENGSHA_FILES.nc + +fengsha_species:: + clayf 1.00000 clayf 1 + sandf 1.00000 sandf 1 + drag 1.00000 drag 1 + uthr 1.00000 uthr 1 # # Input emissions @@ -194,3 +208,5 @@ myemis_species:: SESQ TOLU :: + + diff --git a/src/model/Makefile.am b/src/model/Makefile.am index 61c4887b..280d509c 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,10 @@ 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)/DUST_EMIS.F + libCCTM_a_CPPFLAGS = -DSUBST_FILES_ID=\"FILES_CTM.EXT\" @@ -289,7 +290,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 +302,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 +319,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 +348,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 +369,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 +379,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 +388,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 +406,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 +421,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 +436,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 +449,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 +458,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 +617,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 +638,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 +650,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 +662,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 +672,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 0c12a885..42b6fd24 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,9 @@ 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-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 +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)/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 +504,14 @@ 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)/DUST_EMIS.F # local version of CCTM source files localCCTM = $(builddir)/src @@ -757,8 +758,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 +980,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 +1019,10 @@ $(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-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 +1274,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 +1618,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 +$(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 -$(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.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 +2167,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 +2179,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 +2196,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 +2225,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 +2246,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 +2256,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 +2265,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 +2283,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 +2298,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 +2313,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 +2326,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 +2335,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 +2494,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 +2515,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 +2527,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 +2539,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 +2549,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 00000000..d616c347 --- /dev/null +++ b/src/model/src/ASX_DATA_MOD.F @@ -0,0 +1,1464 @@ +!------------------------------------------------------------------------! +! 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 ) + + ! write(*,*) 'FENGSHA IS = ', FENGSHA + IF ( FENGSHA ) THEN + XMSG = 'Using the Fengsha Wind-Blown dust emission model...' + CALL M3MSG2( XMSG ) + END IF + + 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 + 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 + + 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 00000000..bd1a8125 --- /dev/null +++ b/src/model/src/DUST_EMIS.F @@ -0,0 +1,1527 @@ + +!------------------------------------------------------------------------! +! 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 + USE ASX_DATA_MOD, ONLY : MET_DATA !uses met 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 ) +! print *,'Hello From Dust Module' + 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 +! print *,' Hello from Fengsha' +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/shr/aqm_config_mod.F90 b/src/shr/aqm_config_mod.F90 index c9ddc1a4..971f8b20 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 = .true. logical :: verbose = .false. type(aqm_species_type), pointer :: species => null() end type aqm_config_type @@ -174,7 +175,16 @@ subroutine aqm_config_read(model, config, rc) file=__FILE__, & rcToReturn=rc)) & return ! bail out - + + ! FENGSHA Options + call ESMF_ConfigGetAttribute(cf, config % fengsha_yn, & + label="fengsha_yn:", default=.true., 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) @@ -503,6 +513,13 @@ subroutine aqm_config_log(config, name, rc) call ESMF_LogWrite(trim(name) // ": config: read: run_aerosol: 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 (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__, & diff --git a/src/shr/aqm_emis_mod.F90 b/src/shr/aqm_emis_mod.F90 index 5590ef1d..12cf8171 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 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 diff --git a/src/shr/aqm_methods.F90 b/src/shr/aqm_methods.F90 index f4c4a8ff..b7a45d21 100644 --- a/src/shr/aqm_methods.F90 +++ b/src/shr/aqm_methods.F90 @@ -148,11 +148,11 @@ 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 ', & - 'ZRUF ', & + 'ZRUF ', & 'HFX ', 'WSPD10 ', & 'GSW ', 'RGRND ', & 'RNA ', 'RCA ', & @@ -165,11 +165,13 @@ 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 ', & - 'M ', & + 'M ', & 'WATTS/M**2 ', 'M/S ', & 'WATTS/M**2 ', 'WATTS/M**2 ', & 'CM ', 'CM ', & @@ -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 ', & + '1 ', '1 ', & + '1 ', 'M/S ' /) ELSE IF ( TRIM( FNAME ) .EQ. TRIM( MET_CRO_3D ) ) THEN @@ -330,6 +334,8 @@ logical function envyn(name, description, defaultval, status) envyn = associated(em) case ('CTM_GRAV_SETL') envyn = .false. + case ('CTM_FENGSHA') + envyn = config % fengsha_yn case ('INITIAL_RUN') envyn = .true. case default @@ -640,6 +646,10 @@ 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 select case (trim(vname)) case ("HFX") @@ -736,6 +746,48 @@ logical function interpx( fname, vname, pname, & buffer(k) = 0.01 * stateIn % zorl(c,r) end do end do + + ! fengsha variables + case ("CLAYF") + ! p2d => stateIn % cclayf + 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. + end if + case ("SANDF") + ! p2d => stateIn % csandf + 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. + end if + case ("DRAG") + ! p2d => stateIn % cdrag + 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. + end if + case ("UTHR") + ! p2d => stateIn % cuthr + 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. + end if case default ! return end select